--- /dev/null
+.DS_Store
+Thumbs.db
--- /dev/null
+df32func\r
+========\r
+Some useful helper functions to speed up development when working with DataFlex\r
+3.2 console mode.\r
+\r
+Requirements\r
+------------\r
+MinGW or compatible GNU C compiler: http://www.mingw.org/\r
+DataFlex 3.2 Console Mode or greater: http://www.dataaccess.com/\r
+\r
+Installation\r
+------------\r
+Ensure you have both DF32 and MinGW environments set up correctly and have both \r
+bin directories are in your path (i.e. locations of "dfcomp" and "make")\r
+\r
+Open a DOS prompt and cd into df32func directory.\r
+\r
+To build the dynamic link library and the dataflex precompiled package:\r
+\r
+ build all\r
+\r
+To build just the dataflex precompiled package:\r
+\r
+ build df\r
+\r
+Or build each independently\r
+\r
+The dynamic link library:\r
+\r
+ cd src/c\r
+ make clean\r
+ make\r
+\r
+The dataflex precompiled package:\r
+\r
+ cd src/df32\r
+ dfcomp df32func.mk -p\r
+ \r
+Alternatively include the dataflex includes as required directly in dataflex\r
+source code.
--- /dev/null
+@echo off\r
+\r
+set LC1=%1\r
+set LC1=%LC1:A=a%\r
+set LC1=%LC1:B=b%\r
+set LC1=%LC1:C=c%\r
+set LC1=%LC1:D=d%\r
+set LC1=%LC1:E=e%\r
+set LC1=%LC1:F=f%\r
+set LC1=%LC1:G=g%\r
+set LC1=%LC1:H=h%\r
+set LC1=%LC1:I=i%\r
+set LC1=%LC1:J=j%\r
+set LC1=%LC1:K=k%\r
+set LC1=%LC1:L=l%\r
+set LC1=%LC1:M=m%\r
+set LC1=%LC1:N=n%\r
+set LC1=%LC1:O=o%\r
+set LC1=%LC1:P=p%\r
+set LC1=%LC1:Q=q%\r
+set LC1=%LC1:R=r%\r
+set LC1=%LC1:S=s%\r
+set LC1=%LC1:T=t%\r
+set LC1=%LC1:U=u%\r
+set LC1=%LC1:V=v%\r
+set LC1=%LC1:W=w%\r
+set LC1=%LC1:X=x%\r
+set LC1=%LC1:Y=y%\r
+set LC1=%LC1:Z=z%\r
+\r
+if A%LC1%A == AdebugA goto do_debug\r
+if A%LC1%A == AallA goto do_all\r
+if A%LC1%A == AdfA goto do_df\r
+if A%LC1%A == AcleanA goto do_clean\r
+goto unknown\r
+\r
+:do_clean\r
+ @echo MAKE: Cleaning for df32func dll library\r
+ cd src\c\r
+ if %errorlevel% == 0 goto cclean\r
+ @echo Can't cd to directory (Error level %errorlevel%)\r
+ goto errors \r
+ :cclean\r
+ make clean\r
+ cd ..\..\r
+ @echo DEL: Cleaning for df32func DataFlex precompiled package\r
+ cd src\df32\r
+ del df32func.flp df32func.pki\r
+ cd ..\..\r
+ goto do_exit\r
+:do_all\r
+ @echo MAKE: Compiling df32func dll library\r
+ cd src\c\r
+ if %errorlevel% == 0 goto cmake\r
+ @echo Can't cd to directory (Error level %errorlevel%)\r
+ goto errors \r
+ :cmake\r
+ make clean\r
+ make\r
+ if %errorlevel% == 0 goto okayc\r
+ @echo Errors occoured during compile for df32func.dll (Error level %errorlevel%)\r
+ goto errors\r
+ :okayc\r
+ cd ..\..\r
+:do_df \r
+ @echo DFCOMP: Compiling df32func DataFlex precompiled package\r
+ cd src\df32\r
+ if %errorlevel% == 0 goto dfmake\r
+ @echo Can't cd to directory (Error level %errorlevel%)\r
+ goto errors \r
+ :dfmake\r
+ dfcomp df32func.mk -p\r
+ if %errorlevel% == 0 goto okaydf\r
+ @echo Errors occoured during compile for df32func.flp (Error level %errorlevel%)\r
+ goto errors\r
+ :okaydf \r
+ @echo df32func.inc last compiled on %date% at %time% > df32func.inc.autodoc\r
+ @echo df32func DLL functions: >> df32func.inc.autodoc\r
+ findstr /s /i /b "external_function" *.* >> df32func.inc.autodoc\r
+ @echo df32func functions: >> df32func.inc.autodoc\r
+ findstr /s /i /b "function " *.* >> df32func.inc.autodoc\r
+ @echo df32func procedures: >> df32func.inc.autodoc\r
+ findstr /s /i /b "procedure " *.* >> df32func.inc.autodoc \r
+ @echo df32func classes: >> df32func.inc.autodoc\r
+ findstr /s /i /b "class " *.* >> df32func.inc.autodoc\r
+ cd ..\..\r
+ goto do_exit\r
+:do_debug\r
+ @echo DFCOMP: Compiling df32func DataFlex debug package df32fdbg.mk\r
+ del df32fdbg.mk\r
+ copy df32func.mk df32fdbg.mk\r
+ dfcomp df32fdbg.mk -p -f\r
+ goto do_exit\r
+\r
+:unknown\r
+@echo Unknown action: "%LC1%"\r
+exit /B\r
+\r
+:errors\r
+@echo Compilation failed: see above for detail\r
+exit /B\r
+\r
+:do_exit\r
+@echo Compilation completed successfully\r
+exit /B\r
+\r
+\r
--- /dev/null
+# Project: df32func\r
+\r
+CC = gcc.exe\r
+WINDRES = windres.exe\r
+RES = df32func.res\r
+OBJ = df32func.o $(RES)\r
+LINKOBJ = df32func.o $(RES)\r
+LIBS = --no-export-all-symbols --add-stdcall-alias -lwsock32 \r
+BIN = df32func.dll\r
+CFLAGS = -O2\r
+DLLWRAP=dllwrap.exe\r
+DEFFILE=libdf32func.def\r
+STATICLIB=libdf32func.a\r
+RM = del -f\r
+\r
+.PHONY: all all-before all-after clean clean-custom\r
+\r
+all: all-before df32func.dll all-after\r
+\r
+clean: clean-custom\r
+ ${RM} $(OBJ) $(BIN) $(RES) $(DEFFILE) $(STATICLIB)\r
+\r
+$(BIN): $(LINKOBJ)\r
+ $(DLLWRAP) --output-def $(DEFFILE) --implib $(STATICLIB) $(LINKOBJ) $(LIBS) -o $(BIN)\r
+\r
+df32func.o: df32func.c\r
+ $(CC) -c df32func.c -o df32func.o $(CFLAGS)\r
+\r
+df32func.res: df32func.rc \r
+ $(WINDRES) -i df32func.rc --input-format=rc -o $(RES) -O coff \r
--- /dev/null
+Building\r
+========\r
+\r
+Use MinGW:\r
+ make clean\r
+ make
\ No newline at end of file
--- /dev/null
+/*-------------------------------------------------------------------------\r
+ * df32func.c\r
+ * df32func extensions for Console Mode DataFlex 3.2\r
+ *\r
+ * Copyright (c) 2007-2009, glyn@8kb.co.uk\r
+ * Author: Glyn Astill <glyn@8kb.co.uk>\r
+ *\r
+ *-------------------------------------------------------------------------\r
+ */\r
+\r
+#include "df32func.h"\r
+#include <windows.h>\r
+#include <stdio.h>\r
+#include <stdlib.h>\r
+#include <winsock.h>\r
+\r
+SOCKET s, sc; /* Socket handle */\r
+\r
+/*\r
+ * The number of cycles used by the processor since the start obtained on x86\r
+ * processors (Intel, AMD), with the assembly command rdtsc.\r
+ */\r
+int rdtsc()\r
+{\r
+ __asm__ __volatile__("rdtsc");\r
+}\r
+\r
+/*\r
+ * CLIENTSOCKET \96 Creates a communication socket and connects to a remote host on the\r
+ * supplied port and IP\r
+ */\r
+DLLIMPORT int ClientSocket(int PortNo, char* IPAddress){\r
+ /* Start up Winsock */\r
+ WSADATA wsadata;\r
+\r
+ int error = WSAStartup(0x0202, &wsadata);\r
+\r
+ /* Did something happen? */\r
+ if (error){\r
+ return -1;\r
+ }\r
+\r
+ /* Did we get the right Winsock version? */\r
+ if (wsadata.wVersion != 0x0202){\r
+ WSACleanup(); /* Clean up Winsock */\r
+ return -1;\r
+ }\r
+\r
+ /* Fill out the information needed to initialize a socket */\r
+ SOCKADDR_IN target; /* Socket address information */\r
+\r
+ target.sin_family = AF_INET; /* address family Internet */\r
+ target.sin_port = htons (PortNo); /* Port to connect on */\r
+ target.sin_addr.s_addr = inet_addr (IPAddress); /* Target IP */\r
+\r
+ s = socket (AF_INET, SOCK_STREAM, IPPROTO_TCP); /* Create socket */\r
+ if (s == INVALID_SOCKET){\r
+ return -1; /* Couldn't create the socket */\r
+ }\r
+\r
+ /* Try connecting */\r
+ if (connect(s, (SOCKADDR *)&target, sizeof(target)) == SOCKET_ERROR){\r
+ return -1; /* Couldn't connect */\r
+ }\r
+ else{\r
+ return s; /* Success - return our socket number */\r
+ }\r
+}\r
+\r
+/*\r
+ * SERVERSOCKET \96 Creates a communication socket and a tcp server listening on a the\r
+ * supplied port number\r
+ */\r
+DLLIMPORT int ServerSocket(int PortNo){\r
+ /* Start up Winsock */\r
+ WSADATA wsadata;\r
+\r
+ int error = WSAStartup(0x0202, &wsadata);\r
+\r
+ /* Did something happen? */\r
+ if (error){\r
+ return -1;\r
+ }\r
+\r
+ /* Did we get the right Winsock version? */\r
+ if (wsadata.wVersion != 0x0202){\r
+ WSACleanup(); /* Clean up Winsock */\r
+ return -1;\r
+ }\r
+\r
+ /* Fill out the information needed to initialize a socket */\r
+ SOCKADDR_IN target; /* Socket address information */\r
+\r
+ target.sin_family = AF_INET; /* address family Internet */\r
+ target.sin_port = htons (PortNo); /* Port to connect on */\r
+ target.sin_addr.s_addr = INADDR_ANY; /* Target IP */\r
+\r
+ s = socket (AF_INET, SOCK_STREAM, IPPROTO_TCP); /* Create socket */\r
+ if (s == INVALID_SOCKET){\r
+ return -1; /* Couldn't create the socket */\r
+ }\r
+\r
+ /* Try to bind to the socket */\r
+ if (bind(s, (SOCKADDR *)&target, sizeof(target)) == SOCKET_ERROR) {\r
+ return -1; /* Couldn't connect */\r
+ }\r
+ else{\r
+ /* Now we can start listening, We allow SOMNAXCONN connections. This will not return until we get a connection */\r
+ if (listen(s, SOMAXCONN) == SOCKET_ERROR) {\r
+ return -1;\r
+ }\r
+ else{\r
+ return s;\r
+ }\r
+ }\r
+}\r
+\r
+/*\r
+ * CLOSECONNECTION \96 shuts down a communication socket and closes any connection on it\r
+ */\r
+DLLIMPORT void CloseConnection (int socket){\r
+ /* Close the socket if it exists */\r
+ if (socket){\r
+ closesocket(socket);\r
+ }\r
+\r
+ WSACleanup(); /* Clean up Winsock */\r
+}\r
+\r
+/*\r
+ * SEND - Send data over the communication socket\r
+ */\r
+DLLIMPORT int Send(int socket, char* data){\r
+ return send(socket, data, strlen(data), 0);\r
+}\r
+\r
+/*\r
+ * RECEIVE - Recieve data over the client socket\r
+ */\r
+DLLIMPORT int Receive(int socket, char *pData){\r
+ char data[255] = {0};\r
+ int bytesIn = 0;\r
+\r
+ memset(data, 0, sizeof(data));\r
+ bytesIn = recv(socket, data, sizeof(data), 0);\r
+ if (bytesIn == SOCKET_ERROR) {\r
+ return -1;\r
+ }\r
+ sprintf (pData, "%s", data );\r
+ return bytesIn;\r
+}\r
+\r
+/*\r
+ * ACCEPTCLIENT - Accept a client connection\r
+ */\r
+DLLIMPORT int AcceptClient(){\r
+ SOCKADDR_IN client;\r
+ int clientSize = sizeof(client);\r
+ sc = accept(s, (SOCKADDR *)&client, &clientSize);\r
+ if (sc == INVALID_SOCKET){\r
+ return -1;\r
+ }\r
+ return sc;\r
+}\r
+\r
+/*\r
+ * Generate a pseudo random integer from an integer\r
+ */\r
+DLLIMPORT unsigned int PseudoRand(unsigned int w){\r
+ unsigned int m_w = w;\r
+ unsigned int m_z = (w / 2);\r
+\r
+ m_z = 36969 * (m_z & 65535) + (m_z >> 16);\r
+ m_w = 18000 * (m_w & 65535) + (m_w >> 16);\r
+ return (m_z << 16) + m_w; /* 32-bit result */\r
+}\r
+\r
+/*\r
+ * Generate a random integer from the cpu rdtsc\r
+ */\r
+DLLIMPORT unsigned int RdtscRand(){\r
+ unsigned int n = 0;\r
+ int i;\r
+ /* First digit must be non-zero: */\r
+ do\r
+ {\r
+ srand(rdtsc());\r
+ n = rand() % 8;\r
+ } while(n == 0);\r
+ for(i = 1; i < 8; i++)\r
+ {\r
+ n *= 8;\r
+ srand(rdtsc());\r
+ n += rand() % 8;\r
+ }\r
+ return n;\r
+}\r
+\r
+/*\r
+ * DLL entry point\r
+ */\r
+BOOL APIENTRY DllMain (HINSTANCE hInst /* Library instance handle. */ ,\r
+ DWORD reason /* Reason this function is being called. */ ,\r
+ LPVOID reserved /* Not used. */ )\r
+{\r
+ switch (reason)\r
+ {\r
+ case DLL_PROCESS_ATTACH:\r
+ break;\r
+\r
+ case DLL_PROCESS_DETACH:\r
+ break;\r
+\r
+ case DLL_THREAD_ATTACH:\r
+ break;\r
+\r
+ case DLL_THREAD_DETACH:\r
+ break;\r
+ }\r
+\r
+ /* Returns TRUE on success, FALSE on failure */\r
+ return TRUE;\r
+}\r
--- /dev/null
+/*-------------------------------------------------------------------------\r
+ * df32func.h\r
+ * df32func extension definitions\r
+ *\r
+ * Copyright (c) 2007-2009, glyn@8kb.co.uk\r
+ * Author: Glyn Astill <glyn@8kb.co.uk>\r
+ *\r
+ *-------------------------------------------------------------------------\r
+ */\r
+\r
+#ifndef _DF32FUNC_H_\r
+#define _DF32FUNC_H_\r
+\r
+#define DLLIMPORT __declspec (dllexport)\r
+\r
+DLLIMPORT void CloseConnection(int socket);\r
+DLLIMPORT int ClientSocket(int PortNo, char* IPAddress);\r
+DLLIMPORT int Send(int socket, char* data);\r
+DLLIMPORT int Receive(int socket, char *pData);\r
+DLLIMPORT int ServerSocket(int PortNo);\r
+DLLIMPORT int AcceptClient();\r
+DLLIMPORT unsigned int PseudoRand(unsigned int w);\r
+DLLIMPORT unsigned int RdtscRand();\r
+\r
+#endif /* _DF32FUNC_H_ */\r
--- /dev/null
+#include <windows.h> // include for version info constants\r
+\r
+1 VERSIONINFO\r
+FILEVERSION 0,1,1,1\r
+PRODUCTVERSION 0,1,1,1\r
+FILETYPE VFT_DLL\r
+{\r
+ BLOCK "StringFileInfo"\r
+ {\r
+ BLOCK "080904E4"\r
+ {\r
+ VALUE "CompanyName", "8kb.co.uk"\r
+ VALUE "FileVersion", "0.1.1.1"\r
+ VALUE "FileDescription", "df32func extensions for Console Mode DataFlex 3.2"\r
+ VALUE "InternalName", "DF32FUNC"\r
+ VALUE "LegalCopyright", "Copyright © Glyn Astill 2007"\r
+ VALUE "LegalTrademarks", "Glyn Astill, 8kb.co.uk"\r
+ VALUE "OriginalFilename", "df32func.dll"\r
+ VALUE "ProductName", "df32func"\r
+ VALUE "ProductVersion", "0.1.1.1"\r
+ }\r
+ }\r
+ BLOCK "VarFileInfo"\r
+ {\r
+ VALUE "Translation", 0x0809, 1252\r
+ }\r
+}\r
+\r
--- /dev/null
+//-------------------------------------------------------------------------
+// console.h
+// This file contains definitions "font maps" used to draw large chars
+//
+// This file is to be included when using bigText in df32func.mk
+//
+// Copyright (c) 2006-2009, glyn@8kb.co.uk
+//
+// df32func/console.h
+//-------------------------------------------------------------------------
+
+Define __console_h__
+
+//-------------------------------------------------------------------------
+// Global objects
+//-------------------------------------------------------------------------
+
+// Global array used to store "font map" for large text
+object font_array is an array
+end_object
+
+set array_value of (font_array(current_object)) item (ascii("0")) to "1,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1,1,1,1,0,0,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("1")) to "0,0,0,1,1,1,0,0,0,1,1,1,1,1,0,0,0,0,0,1,1,1,0,0,0,0,0,1,1,1,0,0,0,0,0,1,1,1,0,0"
+set array_value of (font_array(current_object)) item (ascii("2")) to "1,1,1,1,1,1,1,1,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,1,1,1,1,1,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("3")) to "1,1,1,1,1,1,1,1,0,0,0,0,0,1,1,1,0,0,1,1,1,1,1,1,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("4")) to "1,1,1,0,0,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,1,1,1,0,0,0,0,0,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("5")) to "1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("6")) to "1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("7")) to "1,1,1,1,1,1,1,1,0,0,0,0,0,1,1,1,0,0,0,0,1,1,1,0,0,0,0,1,1,1,0,0,0,0,1,1,1,0,0,0"
+set array_value of (font_array(current_object)) item (ascii("8")) to "1,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("9")) to "1,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("A")) to "0,1,1,1,1,1,1,0,1,1,1,0,0,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("B")) to "1,1,1,1,1,1,1,0,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,0,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,0"
+set array_value of (font_array(current_object)) item (ascii("C")) to "0,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,1,1,1,0,0,0,0,0,1,1,1,1,0,0,0,0,0,1,1,1,1,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("D")) to "1,1,1,1,1,1,1,0,1,1,1,0,0,1,1,1,1,1,1,0,0,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,0"
+set array_value of (font_array(current_object)) item (ascii("E")) to "1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,1,1,1,1,1,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("F")) to "1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,1,1,1,0,0,0,0,0"
+set array_value of (font_array(current_object)) item (ascii("G")) to "1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,1,1,1,0,0,0,0,0,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("H")) to "1,1,1,0,0,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1,1,1,1,0,0,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("I")) to "1,1,1,1,1,1,1,1,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,1,1,1,1,1,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("J")) to "0,0,0,0,0,1,1,1,0,0,0,0,0,1,1,1,1,1,1,0,0,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("K")) to "1,1,1,0,0,1,1,1,1,1,1,0,1,1,1,0,1,1,1,1,1,1,0,0,1,1,1,0,1,1,1,0,1,1,1,0,0,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("L")) to "1,1,1,0,0,0,0,0,1,1,1,0,0,0,0,0,1,1,1,0,0,0,0,0,1,1,1,0,0,0,0,0,1,1,1,1,1,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("M")) to "1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,0,1,1,1,1,0,1,1,0,1,1,1,1,0,1,1,0,1,1"
+set array_value of (font_array(current_object)) item (ascii("N")) to "1,1,1,0,0,0,1,1,1,1,1,1,0,0,1,1,1,1,0,1,1,0,1,1,1,1,0,0,1,1,1,1,1,1,0,0,0,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("O")) to "1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("P")) to "1,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,1,1,1,0,0,0,0,0"
+set array_value of (font_array(current_object)) item (ascii("Q")) to "1,1,1,1,1,1,1,1,1,1,0,0,0,0,1,1,1,1,0,0,1,0,1,1,1,1,0,0,0,1,1,1,1,1,1,1,1,1,1,0"
+set array_value of (font_array(current_object)) item (ascii("R")) to "1,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,0,1,1,1,0,0,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("S")) to "0,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,1,1,1,1,1,1,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,0"
+set array_value of (font_array(current_object)) item (ascii("T")) to "1,1,1,1,1,1,1,1,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0"
+set array_value of (font_array(current_object)) item (ascii("U")) to "1,1,1,0,0,1,1,1,1,1,1,0,0,1,1,1,1,1,1,0,0,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("V")) to "1,1,0,0,0,0,1,1,1,1,0,0,0,0,1,1,0,1,1,0,0,1,1,0,0,0,1,1,1,1,0,0,0,0,0,1,1,0,0,0"
+set array_value of (font_array(current_object)) item (ascii("W")) to "1,1,0,0,0,0,1,1,1,1,0,0,0,0,1,1,1,1,0,1,1,0,1,1,1,1,0,1,1,0,1,1,1,1,1,1,1,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("X")) to "1,1,0,0,0,0,1,1,1,1,1,0,0,1,1,1,0,0,1,1,1,1,0,0,1,1,1,0,0,1,1,1,1,1,0,0,0,0,1,1"
+set array_value of (font_array(current_object)) item (ascii("Y")) to "1,1,0,0,0,0,1,1,0,1,1,0,0,1,1,0,0,0,1,1,1,1,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0"
+set array_value of (font_array(current_object)) item (ascii("Z")) to "1,1,1,1,1,1,1,1,0,0,0,0,0,1,1,1,0,0,1,1,1,1,0,0,1,1,1,0,0,0,0,0,1,1,1,1,1,1,1,1"
+set array_value of (font_array(current_object)) item (ascii("%")) to "1,1,0,0,0,0,1,1,0,0,0,0,1,1,1,0,0,0,0,1,1,0,0,0,0,1,1,1,0,0,0,0,1,1,0,0,0,0,1,1"
+set array_value of (font_array(current_object)) item (ascii("ø")) to "0,0,0,1,1,0,0,0,0,0,1,0,0,1,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0"
+set array_value of (font_array(current_object)) item (ascii(".")) to "0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0"
+set array_value of (font_array(current_object)) item (ascii("-")) to "0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0"
+set array_value of (font_array(current_object)) item (ascii("+")) to "0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,1,1,1,1,1,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0"
--- /dev/null
+//-------------------------------------------------------------------------\r
+// console.inc\r
+// This file contains some DataFlex 3.2 Console Mode functions\r
+// to manipulate console window.\r
+//\r
+// This file is to be included in df32func.mk\r
+//\r
+// Copyright (c) 2006-2009, glyn@8kb.co.uk\r
+// \r
+// df32func/console.inc\r
+//-------------------------------------------------------------------------\r
+\r
+#IFDEF __console_h__\r
+#ELSE\r
+ #INCLUDE console.h\r
+#ENDIF\r
+\r
+//-------------------------------------------------------------------------\r
+// Global objects\r
+//------------------------------------------------------------------------- \r
+\r
+// Global StringTokenizer used to store "font blocks" for large text\r
+object font_split is a StringTokenizer\r
+end_object\r
+\r
+//-------------------------------------------------------------------------\r
+// Functions\r
+//-------------------------------------------------------------------------\r
+\r
+// Set the display mode to argv lines\r
+function set_mode global integer argv returns integer\r
+ local string l_01tmpStr\r
+\r
+ if (sysconf(sysconf_os_name)) eq "Win32 Console Mode" move "c:\windows\system32\mode con: cols=80 lines=" to l_01tmpStr\r
+ if (sysconf(sysconf_os_name)) ne "Win32 Console Mode" move "c:\windows\command\mode con: cols=80 lines=" to l_01tmpStr\r
+\r
+ append l_01tmpStr argv\r
+ runprogram wait l_01tmpStr\r
+\r
+ function_return 0\r
+end_function\r
+\r
+// Display a text file to screen\r
+function screen_display global string argv returns integer\r
+ local string l_sBuf l_k l_sTmp\r
+ local integer l_i l_iLineAt l_iTotalLines l_iTotalWidth l_iWidthAt\r
+\r
+ // Add color markup here. \r
+ move 1 to l_iWidthAt\r
+ move 0 to l_iLineAt\r
+ move 0 to l_iTotalLines\r
+ move 0 to l_iTotalWidth\r
+\r
+ direct_input channel default_file_channel argv \r
+ while not (seqeof)\r
+ readln channel default_file_channel l_sBuf\r
+ move (rtrim(l_sBuf)) to l_sbuf\r
+ move (replaces("{YELLOW}",l_sBuf,"")) to l_sBuf\r
+ move (replaces("{WHITE}",l_sBuf,"")) to l_sBuf\r
+ move (replaces("{RED}",l_sBuf,"")) to l_sBuf\r
+ move (replaces("{GREEN}",l_sBuf,"")) to l_sBuf\r
+ move (replaces("{BLUE}",l_sBuf,"")) to l_sBuf\r
+ move (replaces("{PURPLE}",l_sBuf,"")) to l_sBuf\r
+ move (replaces("{GREY}",l_sBuf,"")) to l_sBuf\r
+ move (replaces("{BLACK}",l_sBuf,"")) to l_sBuf\r
+ if (length(l_sBuf) > l_iTotalWidth) move ((length(l_sBuf))+1) to l_iTotalWidth\r
+ increment l_iTotalLines\r
+ loop\r
+ close_input channel default_file_channel \r
+\r
+ while not (key.escape)\r
+ direct_input channel default_file_channel argv\r
+ for l_i from 1 to l_iLineAt\r
+ readln channel default_file_channel \r
+ loop\r
+ for l_i from 1 to 22\r
+ readln channel default_file_channel l_sBuf\r
+ gotoxy (l_i-1) 0\r
+\r
+ if (uppercase(l_sBuf) contains "{YELLOW}") begin\r
+ move (replaces("{YELLOW}",l_sBuf,"")) to l_sBuf\r
+ screenmode 1\r
+ end\r
+ if (uppercase(l_sBuf) contains "{WHITE}") begin\r
+ move (replaces("{WHITE}",l_sBuf,"")) to l_sBuf\r
+ screenmode 2\r
+ end\r
+ if (uppercase(l_sBuf) contains "{RED}") begin\r
+ move (replaces("{RED}",l_sBuf,"")) to l_sBuf\r
+ screenmode 28\r
+ end\r
+ if (uppercase(l_sBuf) contains "{GREEN}") begin\r
+ move (replaces("{GREEN}",l_sBuf,"")) to l_sBuf\r
+ screenmode 26\r
+ end\r
+ if (uppercase(l_sBuf) contains "{BLUE}") begin\r
+ move (replaces("{BLUE}",l_sBuf,"")) to l_sBuf\r
+ screenmode 19\r
+ end\r
+ if (uppercase(l_sBuf) contains "{PURPLE}") begin\r
+ move (replaces("{PURPLE}",l_sBuf,"")) to l_sBuf\r
+ screenmode 29\r
+ end\r
+ if (uppercase(l_sBuf) contains "{GREY}") begin\r
+ move (replaces("{GREY}",l_sBuf,"")) to l_sBuf\r
+ screenmode 24\r
+ end\r
+ if (uppercase(l_sBuf) contains "{BLACK}") begin\r
+ move (replaces("{BLACK}",l_sBuf,"")) to l_sBuf\r
+ screenmode 16\r
+ end\r
+\r
+ show (pad(mid(l_sBuf,80,l_iWidthAt),80))\r
+ screenmode 1\r
+ loop\r
+ close_input channel default_file_channel \r
+ \r
+ move "lines " to l_sTmp\r
+ append l_sTmp (l_iLineAt+1) "-" (l_iLineAt+22) " of " (l_iTotalLines)\r
+ if (l_iTotalLines < (l_iLineAt+22)) begin\r
+ move "lines " to l_sTmp\r
+ append l_sTmp (l_iLineAt+1) "-" (l_iTotalLines) " of " (l_iTotalLines)\r
+ end\r
+ gotoxy 23 0\r
+ screenmode 112\r
+ show (center(l_sTmp,80)) \r
+ screenmode 1\r
+ \r
+ gotoxy 26 0\r
+ inkey l_k\r
+ if (key.up) begin\r
+ if (l_iLineAt <> 0) decrement l_iLineAt\r
+ end\r
+ if (key.down) begin\r
+ if ((l_iLineAt+22) < l_iTotalLines) increment l_iLineAt\r
+ end\r
+ if ((ascii(l_k)) = 34) begin\r
+ calc (l_iLineAt-22) to l_iLineAt\r
+ if (l_iLineAt < 0) move 0 to l_iLineAt\r
+ end\r
+ if ((ascii(l_k)) = 35) begin\r
+ calc (l_iLineAt+22) to l_iLineAt\r
+ if (l_iLineAt > (l_iTotalLines-22)) begin\r
+ move (l_iTotalLines-22) to l_iLineAt\r
+ end\r
+ end\r
+ if ((ascii(l_k)) = 44) begin\r
+ move 0 to l_iLineAt\r
+ end\r
+ if ((ascii(l_k)) = 45) begin\r
+ calc (l_iTotalLines-22) to l_iLineAt\r
+ end\r
+ if ((ascii(l_k)) = 4) begin\r
+ if (l_iWidthAt <> 1) decrement l_iWidthAt\r
+ end\r
+ if ((ascii(l_k)) = 5) begin\r
+ if ((l_iWidthAt+80) <= l_iTotalWidth) increment l_iWidthAt\r
+ end\r
+ loop\r
+end_function\r
+\r
+// Draw a large character in a dos window\r
+function draw_bigchar global string argv integer posx integer posy returns integer\r
+ local integer l_onCount l_i l_iChars\r
+ local string l_c\r
+ move 0 to l_onCount\r
+ move (uppercase(argv)) to argv\r
+ \r
+ send delete_data to (font_split(current_object))\r
+ send set_string to (font_split(current_object)) argv ","\r
+ get token_count of (font_split(current_object)) to l_iChars\r
+ \r
+ for l_i from 0 to (l_iChars+1)\r
+ get token_value of (font_split(current_object)) item l_i to l_c\r
+ if ((integer(l_c)) = 1) increment l_onCount\r
+ if (l_i < 8) begin\r
+ gotoxy posx (posy+l_i)\r
+ if ((integer(l_c)) = 0) show (character(32))\r
+ if ((integer(l_c)) = 1) show (character(219))\r
+ end\r
+ if ((l_i >= 8) and (l_i < 16)) begin\r
+ gotoxy (posx+1) (posy+l_i-8)\r
+ if ((integer(l_c)) = 0) show (character(32))\r
+ if ((integer(l_c)) = 1) show (character(219))\r
+ end\r
+ if ((l_i >= 16) and (l_i < 24)) begin\r
+ gotoxy (posx+2) (posy+l_i-16)\r
+ if ((integer(l_c)) = 0) show (character(32))\r
+ if ((integer(l_c)) = 1) show (character(219))\r
+ end\r
+ if ((l_i >= 24) and (l_i < 32)) begin\r
+ gotoxy (posx+3) (posy+l_i-24)\r
+ if ((integer(l_c)) = 0) show (character(32))\r
+ if ((integer(l_c)) = 1) show (character(219))\r
+ end\r
+ if ((l_i >= 32) and (l_i <= 40)) begin\r
+ gotoxy (posx+4) (posy+l_i-32)\r
+ if ((integer(l_c)) = 0) show (character(32))\r
+ if ((integer(l_c)) = 1) show (character(219))\r
+ end\r
+ loop\r
+ \r
+ function_return l_onCount\r
+end_function\r
+\r
+// Draw large text in a dos window\r
+function big_text global string argv integer posx integer posy returns integer\r
+ local integer l_iResult l_i\r
+ local string l_tmpStr\r
+\r
+ for l_i from 1 to (length(argv))\r
+ move (mid(argv,1,l_i)) to l_tmpStr\r
+ get array_value of (font_array(current_object)) item (ascii(l_tmpStr)) to l_tmpStr\r
+ move (draw_bigchar(l_tmpStr,posx,(posy+((l_i-1)*9)))) to l_iResult\r
+ loop\r
+ function_return l_i\r
+end_function\r
--- /dev/null
+//-------------------------------------------------------------------------\r
+// data.inc\r
+// This file contains some DataFlex 3.2 Console Mode classes\r
+// to provide some useful data structures.\r
+//\r
+// This file is to be included in df32func.mk\r
+//\r
+// Copyright (c) 2006-2009, glyn@8kb.co.uk\r
+// \r
+// df32func/data.inc\r
+//-------------------------------------------------------------------------\r
+\r
+//-------------------------------------------------------------------------\r
+// Classes\r
+//-------------------------------------------------------------------------\r
+\r
+// Linked list class - impliments a linked list type structure in an array, unlike\r
+// traditional linked lists the data is actually the prev/next links (array indexes)\r
+//\r
+// Prev and next addresses are stored as a string "prev,next" rather than using XORing;\r
+// this is so we can start traversal in either direction from a particular address\r
+// without having to also know the prev or next address.\r
+//\r
+// Get methods:\r
+// probe_state - Returns a summary of the linked list state\r
+// first_link - Returns the first link in the list\r
+// last_link - Returns the last link in the list\r
+// link_count - Returns the total number of links\r
+// next_link <current_link> - Returns the next link after the link id passed in\r
+// prev_link <current_link> - Returns the previous link after the link id passed in\r
+//\r
+// Set methods: (All of the following methods are intended to be private)\r
+// next_link <current_link> - Sets the next link after the link id passed in\r
+// prev_link <current_link> - Sets the previous link after the link id passed in\r
+// seek_link - Seeks out the position in the list for a new link \r
+//\r
+// Send message methods:\r
+// insert_link - Insert a new item into the linked list\r
+// remove_link - Remove an item from the linked list\r
+//\r
+//\r
+// Example usage:\r
+// \r
+// string buf\r
+// integer max min count i\r
+// \r
+// object test is a linkedlist\r
+// end_object\r
+// \r
+// // Create some links\r
+// for i from 10 to 15\r
+// send insert_link to test (i*100)\r
+// loop\r
+// for i from 1 to 5\r
+// send insert_link to test (i*100)\r
+// loop\r
+// \r
+// send insert_link to test 750\r
+//\r
+// // Remove a link\r
+// send remove_link to test 300\r
+// \r
+// // Access the list\r
+// get probe_state of test to buf\r
+// get first_link of test to min\r
+// get last_link of test to max\r
+// get link_count of test to count\r
+// \r
+// showln "There are " count " items in the linked list"\r
+// showln buf\r
+// \r
+// show "Traverse forwards: "\r
+// move min to i\r
+// while (i <> -1) \r
+// show i "->" \r
+// get next_link of test item i to i\r
+// loop\r
+// showln "END"\r
+// \r
+// show "Traverse backwards: "\r
+// move max to i\r
+// while (i <> -1) \r
+// show i "->" \r
+// get prev_link of test item i to i\r
+// loop\r
+// showln "END"\r
+\r
+class linkedlist is an array\r
+ procedure construct_object integer argc\r
+ object mTokens is a StringTokenizer\r
+ end_object\r
+ \r
+ forward send construct_object\r
+ \r
+ property integer c_iMinAddr\r
+ property integer c_iMaxAddr\r
+ property integer c_iCount\r
+ property number c_nDist\r
+ \r
+ set c_iMinAddr to -1\r
+ set c_iMaxAddr to -1\r
+ set c_iCount to 0\r
+ set c_nDist to 1\r
+ end_procedure\r
+ \r
+ procedure delete_data\r
+ set c_iMinAddr to -1\r
+ set c_iMaxAddr to -1\r
+ set c_iCount to 0\r
+ set c_nDist to 1\r
+ forward send delete_data\r
+ end_procedure \r
+ \r
+ function probe_state returns string\r
+ local integer l_iMinAddr l_iMaxAddr l_iCount \r
+ local number l_nDist\r
+ \r
+ get c_iMaxAddr to l_iMaxAddr\r
+ get c_iMinAddr to l_iMinAddr\r
+ get c_iCount to l_iCount\r
+ get c_nDist to l_nDist\r
+ \r
+ function_return ("Address range: "+string(l_iMinAddr)+"<->"+string(l_iMaxAddr)+" Items: "+string(l_iCount)+" Dist: "+string(l_nDist))\r
+ end_function\r
+ \r
+ function last_link returns integer\r
+ local integer l_iMaxAddr\r
+ \r
+ get c_iMaxAddr to l_iMaxAddr\r
+ \r
+ function_return l_iMaxAddr\r
+ end_function\r
+ \r
+ function first_link returns integer\r
+ local integer l_iMinAddr\r
+ \r
+ get c_iMinAddr to l_iMinAddr\r
+ \r
+ function_return l_iMinAddr\r
+ end_function \r
+ \r
+ function link_count returns integer\r
+ local integer l_iCount\r
+ \r
+ get c_iCount to l_iCount\r
+ \r
+ function_return l_iCount\r
+ end_function \r
+ \r
+ function next_link integer l_iAddr returns integer\r
+ local string l_sBuf\r
+ local integer l_iNext\r
+ \r
+ forward get string_value item l_iAddr to l_sBuf\r
+ if (l_sBuf = "") custom_error ERROR_CODE_INVALID_ADDRESS$ ERROR_MSG_INVALID_ADDRESS l_iAddr\r
+ move (integer(right(l_sBuf,(length(l_sBuf)-pos(",",l_sBuf))))) to l_iNext\r
+ \r
+ function_return l_iNext\r
+ end_function\r
+ \r
+ function prev_link integer l_iAddr returns integer\r
+ local string l_sBuf\r
+ local integer l_iPrev\r
+ \r
+ forward get string_value item l_iAddr to l_sBuf\r
+ if (l_sBuf = "") custom_error ERROR_CODE_INVALID_ADDRESS$ ERROR_MSG_INVALID_ADDRESS l_iAddr\r
+ move (integer(left(l_sBuf,pos(",",l_sBuf)-1))) to l_iPrev \r
+ \r
+ function_return l_iPrev\r
+ end_function \r
+ \r
+ procedure set next_link integer l_iAddr integer l_iNext\r
+ local string l_sBuf\r
+ local integer l_iPrev\r
+ \r
+ forward get string_value item l_iAddr to l_sBuf\r
+ move (integer(left(l_sBuf,pos(",",l_sBuf)-1))) to l_iPrev\r
+ forward set array_value item l_iAddr to (string(l_iPrev)+","+string(l_iNext))\r
+ \r
+ end_procedure\r
+\r
+ procedure set prev_link integer l_iAddr integer l_iPrev\r
+ local string l_sBuf\r
+ local integer l_iNext\r
+ \r
+ forward get string_value item l_iAddr to l_sBuf\r
+ move (integer(right(l_sBuf,(length(l_sBuf)-pos(",",l_sBuf))))) to l_iNext\r
+ forward set array_value item l_iAddr to (string(l_iPrev)+","+string(l_iNext))\r
+ \r
+ end_procedure \r
+ \r
+ function seek_link integer l_iAddr returns string\r
+ local integer l_iOn l_iNext l_iPrev l_iMinAddr l_iMaxAddr\r
+ local string l_sBuf\r
+ local number l_nDist\r
+ \r
+ get c_iMaxAddr to l_iMaxAddr\r
+ get c_iMinAddr to l_iMinAddr\r
+ get c_nDist to l_nDist\r
+\r
+\r
+ if (show_debug_lines) begin \r
+ showln "DEBUG: Addr " l_iAddr\r
+ showln "DEBUG: Range " l_iMinAddr " <-> " l_iMaxAddr\r
+ showln "DEBUG: Dist " l_nDist\r
+ end\r
+ \r
+ move l_iMinAddr to l_iPrev\r
+ move l_iMaxAddr to l_iNext \r
+ \r
+ if (l_iAddr > l_iMaxAddr) move l_iMaxAddr to l_iOn\r
+ else move l_iMinAddr to l_iOn\r
+ \r
+ if (l_iOn > -1) begin\r
+ while (l_iOn < l_iAddr)\r
+ forward get string_value item l_iOn to l_sBuf\r
+ if (l_sBuf = "") break\r
+ else begin\r
+ move (integer(left(l_sBuf,pos(",",l_sBuf)-1))) to l_iPrev\r
+ move (integer(right(l_sBuf,(length(l_sBuf)-pos(",",l_sBuf))))) to l_iNext\r
+ end \r
+ if ((l_iNext = -1) or (l_iNext > l_iAddr)) break \r
+ move l_iNext to l_iOn\r
+ loop\r
+ end\r
+ \r
+ if (l_iPrev > l_iAddr) begin \r
+ move l_iPrev to l_iNext\r
+ move -1 to l_iOn\r
+ move -1 to l_iPrev\r
+ end \r
+ \r
+ function_return (string(l_iPrev)+","+string(l_iOn)+","+string(l_iNext))\r
+ end_function\r
+ \r
+ procedure insert_link integer l_iAddr\r
+ local integer l_iMinAddr l_iMaxAddr l_iPrev l_iNext l_iOn l_iCount\r
+ local string l_sBuf\r
+ local number l_nDist\r
+ \r
+ if (l_iAddr < 0) custom_error ERROR_CODE_INVALID_ADDRESS$ ERROR_MSG_INVALID_ADDRESS l_iAddr\r
+ else begin\r
+ forward get string_value item l_iAddr to l_sBuf\r
+ if (l_sBuf <> "") custom_error ERROR_CODE_ADDRESS_TAKEN$ ERROR_MSG_ADDRESS_TAKEN l_iAddr\r
+ else begin\r
+ get c_iMaxAddr to l_iMaxAddr\r
+ get c_iMinAddr to l_iMinAddr\r
+ get seek_link item l_iAddr to l_sBuf\r
+\r
+ send delete_data to (mTokens(current_object))\r
+ send set_string to (mTokens(current_object)) l_sBuf ","\r
+ get integer_value of (mTokens(current_object)) item 0 to l_iPrev\r
+ get integer_value of (mTokens(current_object)) item 1 to l_iOn\r
+ get integer_value of (mTokens(current_object)) item 2 to l_iNext\r
+ \r
+ if (show_debug_lines) begin\r
+ showln "DEBUG: Insert address: " l_iAddr " Seek data '" l_sBuf "'"\r
+ end\r
+ \r
+ if (l_iOn <> -1) set next_link item l_iOn to l_iAddr \r
+ forward set array_value item l_iAddr to (string(l_iOn)+","+string(l_iNext))\r
+ if (l_iNext <> -1) set prev_link item l_iNext to l_iAddr\r
+ \r
+ if (l_iAddr > l_iMaxAddr) begin \r
+ move l_iAddr to l_iMaxAddr\r
+ set c_iMaxAddr to l_iMaxAddr\r
+ end\r
+ if ((l_iAddr < l_iMinAddr) or (l_iMinAddr = -1)) begin\r
+ move l_iAddr to l_iMinAddr\r
+ set c_iMinAddr to l_iMinAddr\r
+ end\r
+ get c_iCount to l_iCount\r
+ get c_nDist to l_nDist\r
+ increment l_iCount\r
+ set c_iCount to l_iCount\r
+ set c_nDist to (number(l_iCount)/(l_iMaxAddr-l_iMinAddr))\r
+ end\r
+ end\r
+ end_procedure\r
+ \r
+ procedure remove_link integer l_iAddr\r
+ local integer l_iMinAddr l_iMaxAddr l_iPrev l_iNext l_iOn l_iCount\r
+ local string l_sBuf\r
+ local number l_nDist\r
+ \r
+ if (l_iAddr < 0) custom_error ERROR_CODE_INVALID_ADDRESS$ ERROR_MSG_INVALID_ADDRESS l_iAddr\r
+ else begin\r
+ get c_iMaxAddr to l_iMaxAddr\r
+ get c_iMinAddr to l_iMinAddr\r
+ forward get string_value item l_iAddr to l_sBuf\r
+ \r
+ move (integer(left(l_sBuf,pos(",",l_sBuf)-1))) to l_iPrev\r
+ move (integer(right(l_sBuf,(length(l_sBuf)-pos(",",l_sBuf))))) to l_iNext\r
+ \r
+ if (show_debug_lines) begin\r
+ showln "DEBUG: Remove address: " l_iAddr " Link data '" l_sBuf "'"\r
+ end\r
+ \r
+ if (l_iPrev <> -1) set next_link item l_iPrev to l_iNext\r
+ if (l_iNext <> -1) set prev_link item l_iNext to l_iPrev\r
+ forward set array_value item l_iAddr to ""\r
+ \r
+ if (l_iMaxAddr = l_iAddr) set c_iMaxAddr to l_iPrev \r
+ if (l_iMinAddr = l_iAddr) set c_iMinAddr to l_iNext \r
+ \r
+ get c_iCount to l_iCount\r
+ get c_nDist to l_nDist\r
+ decrement l_iCount\r
+ set c_iCount to l_iCount\r
+ set c_nDist to (number(l_iCount)/(l_iMaxAddr-l_iMinAddr)) \r
+ end \r
+ end_procedure\r
+\r
+end_class\r
+\r
+// Hashtable class - unlike other similar "hash" data structures which usually\r
+// store key/value pairs; the hashtable class was only initially intended to \r
+// store a key and return a hash index. Typical use would usually have been \r
+// to then store the value in an array at the hash index. (See the "hash" class\r
+// below for a key/value orientated class)\r
+// It is however possible to use insert_at_hash and find_at_hash to store a different\r
+// value at a particular key hash, this is however an afterthought and colisions are \r
+// possible.\r
+//\r
+// Send message methods:\r
+// delete_data - Clear the hashtable\r
+// hash_algorithm - Set the hash algorithm, any of ("hash_for_df_arrays", \r
+// "hash_reduced_djb2", "hash_reduced_lazy", "hash_reduced_sdbm")\r
+// with "hash_for_df_arrays" being the default.\r
+// remove_hash - Removes an item from the hashtable.\r
+//\r
+// Set methods:\r
+// item_ptr - Set the index of the current item_ptr (next_hash will return the next item from this)\r
+//\r
+// Get methods:\r
+// item_count\r
+// insert_hash - Insert a value (where the key is equal to the value) and return hash index\r
+// insert_at_hash - Insert a value at the hash index of a key and return hash index\r
+// find_hash - Check if a value is stored in the hash (where the key is equal to the value) and return it's hash index\r
+// find_at_hash - Check if a value is stored in the hash at the hash index of a key and return it's hash index\r
+// value_at_index - Return the value stored at a particular hash index\r
+// string_at_index - Same as above, but specifically retun in string context\r
+// next_hash - Get the next value stored in the hash\r
+// item_ptr - Get the index of the last value returned by next_hash\r
+//\r
+// Example usage:\r
+//\r
+// object myHashtable is a hashTable\r
+// end_object\r
+//\r
+// integer i ix\r
+// string k\r
+//\r
+// clearscreen\r
+// get insert_hash of (myHashtable(current_object)) item "ABC" to i\r
+// get insert_hash of (myHashtable(current_object)) item "HELLO" to ix\r
+// get insert_hash of (myHashtable(current_object)) item "ZZZ" to i\r
+// send remove_hash to (myHashtable(current_object)) ix\r
+// get item_count of (myHashtable(current_object)) to i \r
+//\r
+// get find_hash of (myHashtable(current_object)) item "HELLO" to i\r
+// showln i\r
+//\r
+// set item_ptr of (myHashTable(current_object)) to 0\r
+// move 0 to i\r
+// while (i <> -1)\r
+// get next_hash of (myHashtable(current_object)) to k\r
+// get item_ptr of (myHashtable(current_object)) to i \r
+//\r
+// showln "*** " i " " k\r
+// inkey k\r
+// loop\r
+//\r
+class hashtable is an array\r
+ procedure construct_object integer argc\r
+ forward send construct_object\r
+ property integer c_iMaxHash public argc\r
+ property integer c_iMinHash\r
+ property integer c_iItems\r
+ property integer c_iItemP\r
+ property string c_sHashAlgorithm\r
+ set c_sHashAlgorithm to "hash_for_df_arrays"\r
+ set c_iMinHash to 99999999\r
+ end_procedure\r
+ \r
+ procedure delete_data\r
+ set c_iMinHash to 0\r
+ set c_iMaxHash to 0\r
+ set c_iItems to 0\r
+ set c_iItemP to 0\r
+ forward send delete_data\r
+ end_procedure\r
+ \r
+ procedure hash_algorithm string l_sType\r
+ local integer l_iItems\r
+ \r
+ get c_iItems to l_iItems\r
+ \r
+ // Allow algorithm change only when empty.\r
+ if (l_iItems = 0) begin\r
+ if (trim(lowercase(l_sType)) = "hash_for_df_arrays") set c_sHashAlgorithm to "hash_for_df_arrays"\r
+ if (trim(lowercase(l_sType)) = "hash_reduced_djb2") set c_sHashAlgorithm to "hash_reduced_djb2"\r
+ if (trim(lowercase(l_sType)) = "hash_reduced_sdbm") set c_sHashAlgorithm to "hash_reduced_sdbm"\r
+ if (trim(lowercase(l_sType)) = "hash_reduced_lazy") set c_sHashAlgorithm to "hash_reduced_lazy"\r
+ end\r
+ end_procedure\r
+ \r
+ procedure set item_ptr integer l_iItemP\r
+ set c_iItemP to l_iItemp\r
+ end_procedure\r
+ \r
+ function item_ptr returns integer\r
+ local integer l_iItemP\r
+ get c_iItemP to l_iItemP\r
+ function_return l_iItemP\r
+ end_function\r
+ \r
+ procedure remove_hash integer l_iHash\r
+ local string l_sNext\r
+ local integer l_iItems\r
+ \r
+ get c_iItems to l_iItems\r
+ if (l_iItems > 0) begin\r
+ forward get array_value item (l_iHash+1) to l_sNext\r
+ if (trim(l_sNext) <> "") forward set array_value item l_iHash to "<!!#ITEM REMOVED#!!>"\r
+ if (trim(l_sNext) = "") forward set array_value item l_iHash to ""\r
+ set c_iItems to (l_iItems-1)\r
+ end\r
+ end_procedure\r
+ \r
+ function item_count returns integer\r
+ local integer l_iItems\r
+ get c_iItems to l_iItems\r
+ function_return l_iItems\r
+ end_procedure\r
+ \r
+ function write_hash string l_sHash string l_sValue returns integer\r
+ local integer l_iHash l_iMinHash l_iMaxHash l_iItems l_iReuse\r
+ local string l_sTmp l_sHashAlgorithm l_sStorage\r
+\r
+ if (l_sValue = "") begin\r
+ move l_sHash to l_sStorage\r
+ end\r
+ else begin\r
+ move l_sValue to l_sStorage\r
+ end\r
+\r
+ // Get our object properties\r
+ get c_iMaxHash to l_iMaxHash\r
+ get c_iMinHash to l_iMinHash\r
+ get c_iItems to l_iItems\r
+ get c_sHashAlgorithm to l_sHashAlgorithm\r
+ \r
+ // Generate an initial hash\r
+ move 0 to l_iHash\r
+ \r
+ case begin\r
+ case (l_sHashAlgorithm = "hash_reduced_djb2") move (reduce_hash(hash_djb2(l_sHash))) to l_iHash\r
+ case break\r
+ case (l_sHashAlgorithm = "hash_reduced_sdbm") move (reduce_hash(hash_sdbm(l_sHash))) to l_iHash\r
+ case break\r
+ case (l_sHashAlgorithm = "hash_reduced_lazy") move (reduce_hash(hash_lazy(l_sHash))) to l_iHash\r
+ case break\r
+ case else move (hash_for_df_arrays(l_sHash)) to l_iHash\r
+ case break\r
+ case end\r
+ \r
+ // Then we check in the array to see if out hash is available or equal\r
+ // if not we bucket the value by moveing along into the next available slot\r
+ move 0 to l_iReuse\r
+ next_bucket01:\r
+ forward get string_value item l_iHash to l_sTmp\r
+ if ((l_sTmp <> "") and (l_sTmp <> l_sStorage)) begin\r
+ // If we come across a removed item we may want to reuse the hash space\r
+ if ((l_sTmp = "<!!#ITEM REMOVED#!!>") and (l_iReuse = 0)) move l_iHash to l_iReuse \r
+ calc (l_iHash+1) to l_iHash\r
+ goto next_bucket01\r
+ end\r
+ \r
+ // If this is a new object and we have a slot to reuse then do so here\r
+ if ((l_iReuse <> 0) and (l_sTmp = "")) move l_iReuse to l_iHash \r
+ if (l_iHash > l_iMaxHash) move l_iHash to l_iMaxHash\r
+ if (l_iHash < l_iMinHash) move l_iHash to l_iMinHash\r
+ forward set array_value item l_iHash to l_sStorage\r
+ \r
+ set c_iMaxHash to l_iMaxHash\r
+ set c_iMinHash to l_iMinHash\r
+ set c_iItems to (l_iItems+1)\r
+ \r
+ function_return l_iHash\r
+ end_function\r
+\r
+ function insert_hash string l_sHash returns integer\r
+ local integer l_iHash\r
+ get write_hash item l_sHash item "" to l_iHash\r
+ function_return l_iHash\r
+ end_procedure\r
+ \r
+ function insert_at_hash string l_sHash string l_sValue returns integer\r
+ local integer l_iHash\r
+ get write_hash item l_sHash item l_sValue to l_iHash\r
+ function_return l_iHash\r
+ end_procedure\r
+ \r
+ function read_hash string l_sHash string l_sValue returns integer\r
+ local integer l_iHash l_iMinHash l_iMaxHash l_iItems\r
+ local string l_sTmp l_sHashAlgorithm l_sStorage\r
+\r
+ if (l_sValue = "") begin\r
+ move l_sHash to l_sStorage\r
+ end\r
+ else begin\r
+ move l_sValue to l_sStorage\r
+ end\r
+\r
+ // Get our object properties\r
+ get c_iMaxHash to l_iMaxHash\r
+ get c_iMinHash to l_iMinHash\r
+ get c_iItems to l_iItems\r
+ get c_sHashAlgorithm to l_sHashAlgorithm\r
+ \r
+ // Generate an initial hash\r
+ move 0 to l_iHash\r
+ \r
+ case begin\r
+ case (l_sHashAlgorithm = "hash_reduced_djb2") move (reduce_hash(hash_djb2(l_sHash))) to l_iHash\r
+ case break\r
+ case (l_sHashAlgorithm = "hash_reduced_sdbm") move (reduce_hash(hash_sdbm(l_sHash))) to l_iHash\r
+ case break\r
+ case (l_sHashAlgorithm = "hash_reduced_lazy") move (reduce_hash(hash_lazy(l_sHash))) to l_iHash\r
+ case break\r
+ case else move (hash_for_df_arrays(l_sHash)) to l_iHash\r
+ case break\r
+ case end\r
+\r
+ // Then we check in the array to see if our hash is available or equal\r
+ // if not we bucket the value by moveing along into the next available slot\r
+ next_bucket02:\r
+ forward get string_value item l_iHash to l_sTmp\r
+ \r
+ if ((l_sTmp <> "") and (l_sTmp <> l_sStorage)) begin\r
+ calc (l_iHash+1) to l_iHash\r
+ goto next_bucket02\r
+ end\r
+ if (l_sTmp <> l_sStorage) move -1 to l_iHash\r
+ \r
+ function_return l_iHash\r
+ end_function\r
+ \r
+ function find_hash string l_sHash returns integer\r
+ local integer l_iHash\r
+ get read_hash item l_sHash item "" to l_iHash\r
+ function_return l_iHash\r
+ end_function\r
+ \r
+ function find_at_hash string l_sHash string l_sValue returns integer\r
+ local integer l_iHash\r
+ get read_hash item l_sHash item l_sValue to l_iHash\r
+ function_return l_iHash\r
+ end_function\r
+\r
+ function value_at_index integer l_iHash returns string\r
+ local string l_sBuf\r
+\r
+ forward get array_value item l_iHash to l_sBuf\r
+ \r
+ function_return l_sBuf\r
+ end_function\r
+ \r
+ function string_at_index integer l_iHash returns string\r
+ local string l_sBuf\r
+\r
+ forward get string_value item l_iHash to l_sBuf\r
+ \r
+ function_return l_sBuf\r
+ end_function \r
+ \r
+ function next_hash returns string\r
+ local string l_sBuf\r
+ local integer l_iItemP l_iMaxHash l_iMinHash\r
+ \r
+ get c_iItemP to l_iItemP\r
+ get c_iMaxHash to l_iMaxHash\r
+ get c_iMinHash to l_iMinHash\r
+ \r
+ if (l_iMinHash > l_iItemP) move (l_iMinHash-1) to l_iItemP\r
+ \r
+ move "" to l_sBuf\r
+ while ((l_sBuf = "") and (l_iItemP <= l_iMaxHash))\r
+ increment l_iItemP \r
+ forward get array_value item l_iItemP to l_sBuf\r
+ if (trim(l_sBuf) = "<!!#ITEM REMOVED#!!>") move "" to l_sBuf \r
+ loop\r
+ \r
+ if (l_iItemP > l_iMaxHash) move -1 to l_iItemP\r
+ set c_iItemP to l_iItemP\r
+ \r
+ function_return l_sBuf\r
+ end_function \r
+ \r
+end_class\r
+\r
+// Hash class - more akin to similar "hash" data structures in other languages\r
+// which stores key/value pairs.\r
+// This is a quick 5 minute implementation, it depends on the hashtable object \r
+// above for it's hashing.\r
+//\r
+// Send message methods:\r
+//\r
+// truncate - Clear the hash\r
+// remove_key - Removes a key/value pair from the hash\r
+//\r
+// Set methods:\r
+// value_at_key - Gets the value stored for a particular key\r
+//\r
+// Get methods:\r
+// insert_key - Inserts a key/value pair into the hash\r
+// value_at_key - Retrieves the value stored for a particular key\r
+// item_count - Retrieves the count of items in the hash\r
+//\r
+// Example usage:\r
+// \r
+// \r
+// string key iv buf\r
+// integer i\r
+// \r
+// object test is a hash\r
+// end_object\r
+// \r
+// send insert_key to test "INDEX 1" "VALUE 1"\r
+// send insert_key to test "INDEX 2" "VALUE 2"\r
+// send insert_key to test "INDEX 3" "VALUE 3"\r
+// \r
+// get first_key of test to key\r
+// showln "KEY " key\r
+// get value_at_key of test item key to buf\r
+// showln "VALUE " buf\r
+// \r
+// while (key <> "") \r
+// get next_key of test key to key\r
+// if (key <> "") begin\r
+// showln "KEY " key\r
+// get value_at_key of test item key to buf\r
+// showln "VALUE " buf\r
+// end\r
+// loop\r
+// \r
+// set value_at_key of test item "INDEX 2" item "VALUE TWO"\r
+// showln "SET VALUE AT 'INDEX 2'"\r
+// \r
+// get value_at_key of test item "INDEX 1" to buf\r
+// showln "LOOKUP 'INDEX 1' = " buf\r
+// get value_at_key of test item "INDEX 2" to buf\r
+// showln "LOOKUP 'INDEX 2' = " buf\r
+// \r
+// get item_count of test to i\r
+// showln "ITEM COUNT " i\r
+// \r
+// send remove_key to test "INDEX 3"\r
+// showln "REMOVE AT KEY: 'INDEX 3'"\r
+// \r
+// get item_count of test to i\r
+// showln "ITEM COUNT " i\r
+// \r
+// get value_at_key of test item "INDEX 3" to buf\r
+// showln "LOOKUP 'INDEX 3' =" buf\r
+// \r
+// send truncate to test\r
+// showln "TRUNCATED"\r
+// \r
+// get value_at_key of test item "INDEX 1" to buf\r
+// showln "LOOKUP 'INDEX 1' = " buf\r
+// \r
+// get item_count of test to i\r
+// showln "EMPTY COUNT " i\r
+//\r
+class hash is an array\r
+ procedure construct_object integer argc\r
+ object keystore is a hashtable\r
+ end_object\r
+ \r
+ object linkstore is a linkedlist\r
+ end_object\r
+ \r
+ forward send construct_object\r
+ end_procedure\r
+\r
+ procedure truncate\r
+ send delete_data to (keystore(current_object))\r
+ send delete_data to (linkstore(current_object))\r
+ \r
+ forward send delete_data\r
+ end_procedure \r
+ \r
+ procedure remove_key string l_sKey\r
+ local integer l_iIndex\r
+ get find_hash of (keystore(current_object)) item l_sKey to l_iIndex\r
+ if (l_iIndex <> -1) begin\r
+ send remove_hash to (keystore(current_object)) l_iIndex\r
+ send remove_link to (linkstore(current_object)) l_iIndex\r
+ forward set array_value item l_iIndex to ""\r
+ end\r
+ end_procedure\r
+ \r
+ procedure set value_at_key string l_sKey string l_sValue\r
+ local integer l_iIndex\r
+ \r
+ get find_hash of (keystore(current_object)) item l_sKey to l_iIndex\r
+ forward set array_value item l_iIndex to l_sValue\r
+ \r
+ end_procedure\r
+ \r
+ procedure insert_key string l_sKey string l_sValue\r
+ local integer l_iIndex\r
+ \r
+ get insert_hash of (keystore(current_object)) item l_sKey to l_iIndex\r
+ send insert_link to (linkstore(current_object)) l_iIndex\r
+ forward set array_value item l_iIndex to l_sValue\r
+ \r
+ end_procedure\r
+ \r
+ function value_at_key string l_sKey returns string\r
+ local integer l_iIndex\r
+ local string l_sValue\r
+ \r
+ get find_hash of (keystore(current_object)) item l_sKey to l_iIndex\r
+ forward get string_value item l_iIndex to l_sValue\r
+ \r
+ function_return l_sValue\r
+ end_function\r
+ \r
+ function first_key returns string\r
+ local integer l_iIndex\r
+ local string l_sKey\r
+ \r
+ get first_link of (linkstore(current_object)) to l_iIndex\r
+ get string_at_index of (keystore(current_object)) item l_iIndex to l_sKey\r
+\r
+ function_return l_sKey\r
+ end_function \r
+ \r
+ function next_key string l_sKey returns string\r
+ local integer l_iIndex\r
+ \r
+ get find_hash of (keystore(current_object)) item l_sKey to l_iIndex\r
+ get next_link of (linkstore(current_object)) item l_iIndex to l_iIndex\r
+ get string_at_index of (keystore(current_object)) item l_iIndex to l_sKey\r
+\r
+ function_return l_sKey\r
+ end_function\r
+ \r
+ function item_count returns integer\r
+ local integer l_iResult\r
+ get item_count of (keystore(current_object)) to l_iResult\r
+ \r
+ function_return l_iResult\r
+ end_function\r
+end_class\r
+\r
+// Matrix class - Provides an indexed two-dimensional array / matrix class\r
+//\r
+// This class is sensitive to ascii char 1, which is used for delimiting values \r
+// within the second dimension. The implimentation is rather unrefined and \r
+// stores delimited values within an array, thus the wider the matrix the \r
+// slower any adding removing or sorting will be. \r
+//\r
+// This is designed purely as a convenience to provide something matrix like within \r
+// the limitations of DataFlex 3.2 Console Mode; be sure to keep this in mind before \r
+// using.\r
+//\r
+// To allow quick lookup of linked data, a hash index may be created on one column \r
+// of a matrix at a time.\r
+// A hash index may be added both before and after populating the matrix with your \r
+// data.\r
+//\r
+// As with a hash table the hasing algorithm may be set for the matrix, but to take\r
+// affect this must be called before the hash_on_column message. (see hash.inc \r
+// function for available algorithms)\r
+// \r
+// The hash_is_unique and remove_hash_is_unique messages allow enforcement of unique\r
+// values in the hashed column. If the hash_is_unique message is sent after the \r
+// creation of a hash index on a matrix already populated with data the constraint will \r
+// only apply to new data.\r
+// \r
+// The hash may also be removed from the column (freeing up any memory used, which can\r
+// be fairly large) at any time, this allows for removing the hash from one column and \r
+// re-assigning it to another or changing hash algorithm on the same data.\r
+// \r
+// Lookups on the hash index are performed with the matrix_index_from_value, matrix_index_count_from_value\r
+//\r
+// Send message methods:\r
+// delete_data - Clear the matrix\r
+// matrix_sort - Y pos to sort on\r
+// matrix_delete - X and Y pos to delete \r
+// delete_item - X position to delete (this reshuffles the matrix; avoid using)\r
+// hash_on_column_algorithm - Hash algorithm to use\r
+// hash_on_column - Y pos of column to hash\r
+// remove_hash_on_column - Remove the hash from the column\r
+// hash_is_unique - Add a unique constraint on the hash\r
+// remove_hash_is_unique - Remove a unique constraint from the hash\r
+// matrix_index_lookup_clear - Clear the lookup buffer\r
+//\r
+// Set methods:\r
+// matrix_value - Set a value at X, Y\r
+// matrix_string \r
+//\r
+// Get methods:\r
+// matrix_value - Get a value at X, Y\r
+// matrix_string - Get an string value at X, Y\r
+// matrix_integer - Get an integer value at X, Y\r
+// matrix_numeric - Get an numeric value at X, Y\r
+// matrix_real - Get an real value at X, Y\r
+// matrix_hash_from_value - Get the hash index value used for an indexed column value\r
+// matrix_indextable_from_value - Get list of matrix x pos indexes for a particular hashed value\r
+// matrix_index_lookup_clear - Clear the buffer for an indexed lookup\r
+// matrix_index_count_from_value - Get a count of rows with a particular value\r
+// matrix_index_from_value - Get the next X pos (row) with indexed value. Returns -1 when nothing left to find.\r
+// \r
+// Example usage:\r
+//\r
+//\r
+// object test is a matrix\r
+// end_object\r
+//\r
+// set matrix_value of (test(current_object)) item 0 item 1 to "1" - x then y pos to Value\r
+// get matrix_value of (test(current_object)) item 0 item 1 to tmpStr - x then y pos to Value\r
+// send matrix_sort to (test(current_object)) 1 - x then y pos to sort by\r
+// send matrix_delete to (test(current_object)) 1 1 - x then y pos to delete \r
+// send matrix_delete_row to (test(current_object)) 1 - x essentially blanks record out, no reshuffle\r
+// send delete_item to (test1(current_object)) 1 - x pos (not v efficient), reshuffles\r
+//\r
+// Hash indexed columns usage:\r
+//\r
+// send hash_on_column_algorithm to (test(current_object)) "hash_reduced_lazy"\r
+// send hash_on_column to (test(current_object)) 0\r
+// send remove_hash_on_column to (test(current_object)) \r
+// send hash_is_unique to (test(current_object)) \r
+// \r
+// send matrix_index_lookup_clear to (test(current_object)) \r
+// get matrix_index_count_from_value of (test(current_object)) item "1" to count\r
+// get matrix_index_from_value of (test(current_object)) item "1" to x_pos \r
+// get matrix_indextable_from_value of (test(current_object)) item "1" to tmpStr \r
+// get matrix_hash_from_value of (test(current_object)) item "1" to tmpInt \r
+\r
+class matrix is an array\r
+ procedure construct_object integer argc\r
+ object mTokens is a StringTokenizer\r
+ end_object\r
+ \r
+ forward send construct_object\r
+ property integer c_iWidth public argc\r
+ property integer c_iHashOn\r
+ property integer c_iLastIndexTableHash\r
+ property integer c_iLastIndexTablePos\r
+ property integer c_iEnforceUnique\r
+ property string c_sHashAlgorithm\r
+ \r
+ set c_sHashAlgorithm to ""\r
+ set c_iHashOn to -1\r
+ set c_iLastIndexTableHash to -1\r
+ set c_iLastIndexTablePos to -1\r
+ set c_iEnforceUnique to 0\r
+ end_procedure\r
+ \r
+ procedure hash_on_column_algorithm string hashalg\r
+ if ((hashalg = "hash_reduced_djb2") or (hashalg = "hash_reduced_sdbm") or (hashalg = "hash_reduced_lazy") or (hashalg = "hash_for_df_arrays") or (hashalg = "")) begin\r
+ set c_sHashAlgorithm to hashalg\r
+ end \r
+ end_procedure\r
+ \r
+ procedure hash_is_unique\r
+ set c_iEnforceUnique to 1\r
+ end_procedure \r
+ \r
+ procedure remove_hash_is_unique\r
+ set c_iEnforceUnique to 0\r
+ end_procedure \r
+ \r
+ procedure hash_on_column integer l_iColumn\r
+ local integer l_iMax l_iHashOn l_i l_iHash l_iEnforceUnique l_iHashError\r
+ local string l_sBuf l_sTmp l_sHashAlgorithm \r
+ \r
+ forward get item_count to l_iMax\r
+ get c_iHashOn to l_iHashOn\r
+ \r
+ // Allow adding hash only when no hash already set\r
+ if ((l_iHashOn = -1) and (l_iColumn >= 0)) begin\r
+ \r
+ object mHash_array is an array\r
+ end_object \r
+ \r
+ object mHash_table is a hashTable\r
+ end_object\r
+ \r
+ get c_sHashAlgorithm to l_sHashAlgorithm\r
+ get c_iEnforceUnique to l_iEnforceUnique\r
+ \r
+ if (l_sHashAlgorithm <> "") begin\r
+ send hash_algorithm to (mHash_table(current_object)) l_sHashAlgorithm\r
+ end\r
+ \r
+ if (l_iMax <> 0) begin\r
+ // Hash the current matrix if not empty\r
+ move (l_iMax-1) to l_iMax \r
+ \r
+ for l_i from 0 to l_iMax\r
+ forward get array_value item l_i to l_sBuf\r
+ \r
+ send delete_data to (mTokens(current_object))\r
+ send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
+ get token_value of (mTokens(current_object)) item l_iColumn to l_sTmp \r
+ get insert_hash of (mHash_table(current_object)) item l_sTmp to l_iHash\r
+ get string_value of (mHash_array(current_object)) item l_iHash to l_sTmp\r
+ \r
+ if ((l_iEnforceUnique = 1) and (length(replace("|",l_sTmp,"")) <> 0)) begin\r
+ custom_error ERROR_CODE_DUPLICATE_HASH_KEY$ ERROR_MSG_DUPLICATE_HASH_KEY ERROR_DETAIL_DUPLICATE_HASH_KEY l_iColumn\r
+ move 1 to l_iHashError\r
+ break\r
+ end\r
+ else if not (l_sTmp contains ("|"+string(l_i)+"|")) begin\r
+ if (length(l_sTmp) = 0) move "|" to l_sTmp\r
+ append l_sTmp (string(l_i)+"|")\r
+ set array_value of (mHash_array(current_object)) item l_iHash to l_sTmp\r
+ end\r
+ loop\r
+ end\r
+ \r
+ if (l_iHashError = 0) begin\r
+ set c_iHashOn to l_iColumn\r
+ end\r
+ else begin\r
+ send destroy_object to (mHash_array(current_object))\r
+ send destroy_object to (mHash_table(current_object)) \r
+ end\r
+ end\r
+ end_procedure\r
+ \r
+ procedure remove_hash_on_column\r
+ local integer l_iHashOn\r
+ \r
+ get c_iHashOn to l_iHashOn\r
+ \r
+ if (l_iHashOn <> -1) begin \r
+ set c_iHashOn to -1\r
+ send destroy_object to (mHash_array(current_object))\r
+ send destroy_object to (mHash_table(current_object))\r
+ end\r
+ end_procedure\r
+ \r
+ procedure set matrix_value integer itemx integer itemy string val\r
+ local string l_sBuf l_sTmp l_sOldVal \r
+ local integer l_i l_iWidth l_iHashOn l_iHash l_iEnforceUnique l_iHashError\r
+\r
+ move 0 to l_iHashError\r
+ get c_iWidth to l_iWidth\r
+ get c_iHashOn to l_iHashOn\r
+ \r
+ forward get array_value item itemx to l_sBuf\r
+ \r
+ if (itemy > l_iWidth) begin\r
+ set c_iWidth to itemy\r
+ move itemy to l_iWidth\r
+ end\r
+\r
+ // Delimiter is ascii char 1 (start of heading/console interrupt)\r
+ // so any values containing ascii 1 will, of course break the matrix\r
+ send delete_data to (mTokens(current_object))\r
+ send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
+ \r
+ if (l_iHashOn = itemy) begin\r
+ get token_value of (mTokens(current_object)) item itemy to l_sOldVal\r
+ end\r
+ if (val = "") set token_value of (mTokens(current_object)) item itemy to (character(3))\r
+ else set token_value of (mTokens(current_object)) item itemy to (replaces(character(1),(replaces(character(3),val,"")),""))\r
+ \r
+ move "" to l_sBuf\r
+ for l_i from 0 to l_iWidth \r
+ get token_value of (mTokens(current_object)) item l_i to l_sTmp \r
+ if (length(l_sTmp) = 0) move (character(3)) to l_sTmp \r
+ if (length(l_sBuf) <> 0) append l_sBuf (character(1))\r
+ append l_sBuf l_sTmp\r
+ loop\r
+ \r
+ move (replaces(character(3),l_sBuf,"")) to l_sBuf\r
+ \r
+ // Insert/update in the value to the hash\r
+ if ((l_iHashOn = itemy) and (l_sOldVal <> val)) begin \r
+ get c_iEnforceUnique to l_iEnforceUnique\r
+ get insert_hash of (mHash_table(current_object)) item val to l_iHash\r
+ get string_value of (mHash_array(current_object)) item l_iHash to l_sTmp\r
+ \r
+ if ((l_iEnforceUnique = 1) and (length(replace("|",l_sTmp,"")) <> 0)) begin\r
+ custom_error ERROR_CODE_DUPLICATE_HASH_KEY$ ERROR_MSG_DUPLICATE_HASH_KEY ERROR_DETAIL_DUPLICATE_HASH_KEY itemy\r
+ move 1 to l_iHashError\r
+ end\r
+ else if not (l_sTmp contains ("|"+string(itemx)+"|")) begin\r
+ if (length(l_sTmp) = 0) move "|" to l_sTmp\r
+ append l_sTmp (string(itemx)+"|")\r
+ set array_value of (mHash_array(current_object)) item l_iHash to l_sTmp\r
+ end\r
+ \r
+ // Remove old hash (if any) when insert succeeds\r
+ if (l_iHashError = 0) begin\r
+ get find_hash of (mHash_table(current_object)) item l_sOldVal to l_iHash\r
+ if (l_iHash <> 0) begin\r
+ get string_value of (mHash_array(current_object)) item l_iHash to l_sTmp \r
+ if (l_sTmp contains ("|"+string(itemx)+"|")) begin\r
+ move (replace(("|"+string(itemx)+"|"),l_sTmp,"")) to l_sTmp\r
+ if (l_sTmp = "") begin\r
+ send remove_hash to (mHash_table(current_object)) l_iHash\r
+ end\r
+ else begin\r
+ if (left(l_sTmp,1) <> "|") move ("|"+l_sTmp) to l_sTmp\r
+ else append l_sTmp "|"\r
+ end\r
+ set array_value of (mHash_array(current_object)) item l_iHash to l_sTmp\r
+ end\r
+ end\r
+ end\r
+ end\r
+ \r
+ if (l_iHashError = 0) begin\r
+ forward set array_value item itemx to l_sBuf\r
+ end\r
+ end_procedure\r
+ \r
+ function matrix_string integer itemx integer itemy returns string\r
+ local string l_sBuf l_sTmp\r
+\r
+ forward get array_value item itemx to l_sBuf\r
+ \r
+ send delete_data to (mTokens(current_object))\r
+ send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
+ get token_value of (mTokens(current_object)) item itemy to l_sTmp\r
+ \r
+ function_return l_sTmp\r
+ end_function \r
+ \r
+ function matrix_value integer itemx integer itemy returns string\r
+ local string l_sBuf l_sTmp\r
+\r
+ forward get array_value item itemx to l_sBuf\r
+ \r
+ send delete_data to (mTokens(current_object))\r
+ send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
+ get token_value of (mTokens(current_object)) item itemy to l_sTmp\r
+ \r
+ function_return l_sTmp\r
+ end_function \r
+ \r
+ function matrix_integer integer itemx integer itemy returns integer\r
+ local string l_sBuf\r
+ local integer l_iTmp\r
+\r
+ forward get array_value item itemx to l_sBuf\r
+ \r
+ send delete_data to (mTokens(current_object))\r
+ send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
+ get token_value of (mTokens(current_object)) item itemy to l_iTmp\r
+ \r
+ function_return l_iTmp\r
+ end_function\r
+ \r
+ function matrix_number integer itemx integer itemy returns number\r
+ local string l_sBuf\r
+ local number l_nTmp\r
+ \r
+ forward get array_value item itemx to l_sBuf\r
+ \r
+ send delete_data to (mTokens(current_object))\r
+ send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
+ get token_value of (mTokens(current_object)) item itemy to l_nTmp\r
+ \r
+ function_return l_nTmp\r
+ end_function\r
+ \r
+ function matrix_real integer itemx integer itemy returns real\r
+ local string l_sBuf\r
+ local real l_rTmp\r
+ \r
+ forward get array_value item itemx to l_sBuf\r
+ \r
+ send delete_data to (mTokens(current_object))\r
+ send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
+ get token_value of (mTokens(current_object)) item itemy to l_rTmp\r
+ \r
+ function_return l_rTmp\r
+ end_function\r
+ \r
+ function matrix_hash_from_value string val returns integer\r
+ local integer l_iHash l_iHashOn\r
+ \r
+ get c_iHashOn to l_iHashOn\r
+ \r
+ if (l_iHashOn <> -1) begin\r
+ get find_hash of (mHash_table(current_object)) item val to l_iHash\r
+ end\r
+\r
+ function_return l_iHash\r
+ end_function\r
+ \r
+ function matrix_indextable_from_value string val returns string\r
+ local integer l_iHashOn l_iHash\r
+ local string l_sIndexTable\r
+\r
+ get c_iHashOn to l_iHashOn\r
+ \r
+ if (l_iHashOn <> -1) begin\r
+ get find_hash of (mHash_table(current_object)) item val to l_iHash\r
+ get string_value of (mHash_array(current_object)) item l_iHash to l_sIndexTable\r
+ end\r
+\r
+ function_return l_sIndexTable\r
+ end_function\r
+ \r
+ procedure matrix_index_lookup_clear \r
+ local integer l_iHashOn\r
+ \r
+ get c_iHashOn to l_iHashOn\r
+ \r
+ if (l_iHashOn <> -1) begin\r
+ set c_iLastIndexTableHash to -1\r
+ set c_iLastIndexTablePos to -1\r
+ end\r
+ end_procedure\r
+ \r
+ function matrix_index_from_value string val returns integer\r
+ local integer l_iHashOn l_iHash l_iLastIndexTableHash l_iLastIndexTablePos l_iIndex l_iIndexValues\r
+ local string l_sIndexTable\r
+\r
+ get c_iHashOn to l_iHashOn\r
+ move -1 to l_iIndex\r
+ \r
+ if (l_iHashOn <> -1) begin\r
+ get find_hash of (mHash_table(current_object)) item val to l_iHash\r
+ get string_value of (mHash_array(current_object)) item l_iHash to l_sIndexTable\r
+\r
+ get c_iLastIndexTableHash to l_iLastIndexTableHash \r
+ \r
+ if (l_iHash = l_iLastIndexTableHash) begin\r
+ get c_iLastIndexTablePos to l_iLastIndexTablePos\r
+ end\r
+ increment l_iLastIndexTablePos\r
+ \r
+ send delete_data to (mTokens(current_object))\r
+ send set_string to (mTokens(current_object)) l_sIndexTable "|"\r
+ get token_count of (mTokens(current_object)) to l_iIndexValues\r
+ if (l_iLastIndexTablePos <= l_iIndexValues) begin\r
+ get token_value of (mTokens(current_object)) item l_iLastIndexTablePos to l_iIndex\r
+ set c_iLastIndexTableHash to l_iHash\r
+ set c_iLastIndexTablePos to l_iLastIndexTablePos\r
+ end\r
+ else begin\r
+ move -1 to l_iIndex\r
+ set c_iLastIndexTableHash to -1\r
+ set c_iLastIndexTablePos to -1\r
+ end\r
+ end\r
+\r
+ function_return l_iIndex\r
+ end_function\r
+ \r
+ function matrix_index_count_from_value string val returns integer\r
+ local integer l_iHashOn l_iHash l_iIndexValues\r
+ local string l_sIndexTable\r
+ \r
+ get c_iHashOn to l_iHashOn\r
+ \r
+ if (l_iHashOn <> -1) begin\r
+ get find_hash of (mHash_table(current_object)) item val to l_iHash\r
+ get string_value of (mHash_array(current_object)) item l_iHash to l_sIndexTable\r
+ \r
+ send delete_data to (mTokens(current_object))\r
+ send set_string to (mTokens(current_object)) l_sIndexTable "|"\r
+ get token_count of (mTokens(current_object)) to l_iIndexValues\r
+ end\r
+ \r
+ function_return l_iIndexValues\r
+ end_function\r
+ \r
+ procedure set item_count integer newVal\r
+ forward set item_count to newVal\r
+ end_procedure\r
+ \r
+ procedure matrix_delete integer itemx integer itemy\r
+ local string l_sBuf l_sTmp l_sOldVal\r
+ local integer l_i l_iWidth l_iHashOn l_iHash\r
+\r
+ get c_iWidth to l_iWidth\r
+ get c_iHashOn to l_iHashOn\r
+ \r
+ forward get array_value item itemx to l_sBuf\r
+ \r
+ send delete_data to (mTokens(current_object))\r
+ send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
+ \r
+ if (l_iHashOn = itemy) begin \r
+ get token_value of (mTokens(current_object)) item itemy to l_sOldVal\r
+ end\r
+ set token_value of (mTokens(current_object)) item itemy to (character(3))\r
+\r
+ move "" to l_sBuf\r
+ for l_i from 0 to l_iWidth\r
+ get token_value of (mTokens(current_object)) item l_i to l_sTmp\r
+ if (length(l_sTmp) = 0) move (character(3)) to l_sTmp\r
+ if (length(l_sBuf) <> 0) append l_sBuf (character(1))\r
+ append l_sBuf l_sTmp\r
+ loop\r
+ move (replaces(character(3),l_sBuf,"")) to l_sBuf\r
+\r
+ forward set array_value item itemx to l_sBuf\r
+ \r
+ // Delete in the value to the hash\r
+ if (l_iHashOn = itemy) begin \r
+ get find_hash of (mHash_table(current_object)) item l_sOldVal to l_iHash\r
+ if (l_iHash <> 0) begin \r
+ get string_value of (mHash_array(current_object)) item l_iHash to l_sTmp \r
+ if (l_sTmp contains ("|"+string(itemx)+"|")) begin\r
+ move (replace(("|"+string(itemx)+"|"),l_sTmp,"")) to l_sTmp\r
+ if (l_sTmp = "") begin\r
+ send remove_hash to (mHash_table(current_object)) l_iHash\r
+ end\r
+ else begin\r
+ if (left(l_sTmp,1) <> "|") move ("|"+l_sTmp) to l_sTmp\r
+ else append l_sTmp "|"\r
+ end\r
+ set array_value of (mHash_array(current_object)) item l_iHash to l_sTmp\r
+ end \r
+ end\r
+ end\r
+ end_procedure\r
+ \r
+ // Inefficient.\r
+ procedure delete_item integer itemx \r
+ local string l_sBuf l_sOldVal l_sTmp l_sIndexTable\r
+ local integer l_iHashOn l_iHash l_i l_j l_iItems l_iIndexValues l_iIndex\r
+ \r
+ get c_iHashOn to l_iHashOn\r
+ // Delete in the value to the hash\r
+ if (l_iHashOn <> -1) begin\r
+ forward get array_value item itemx to l_sBuf\r
+ send delete_data to (mTokens(current_object))\r
+ send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
+ get token_value of (mTokens(current_object)) item l_iHashOn to l_sOldVal\r
+ get find_hash of (mHash_table(current_object)) item l_sOldVal to l_iHash\r
+ if (l_iHash <> 0) begin \r
+ get string_value of (mHash_array(current_object)) item l_iHash to l_sTmp\r
+ if (l_sTmp contains ("|"+string(itemx)+"|")) begin\r
+ move (replace(("|"+string(itemx)+"|"),l_sTmp,"")) to l_sTmp\r
+ if (l_sTmp = "") begin\r
+ send remove_hash to (mHash_table(current_object)) l_iHash\r
+ end\r
+ else begin\r
+ if (left(l_sTmp,1) <> "|") move ("|"+l_sTmp) to l_sTmp\r
+ else append l_sTmp "|"\r
+ end\r
+ set array_value of (mHash_array(current_object)) item l_iHash to l_sTmp\r
+ end \r
+ end\r
+ \r
+ forward get item_count to l_iItems\r
+ \r
+ for l_i from (itemx+1) to l_iItems\r
+ \r
+ forward get array_value item l_i to l_sBuf\r
+ send delete_data to (mTokens(current_object))\r
+ send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
+ get token_value of (mTokens(current_object)) item l_iHashOn to l_sOldVal\r
+ get find_hash of (mHash_table(current_object)) item l_sOldVal to l_iHash\r
+ \r
+ if (l_iHash <> 0) begin\r
+ get string_value of (mHash_array(current_object)) item l_iHash to l_sIndexTable\r
+ \r
+ send delete_data to (mTokens(current_object))\r
+ send set_string to (mTokens(current_object)) l_sIndexTable "|"\r
+ get token_count of (mTokens(current_object)) to l_iIndexValues\r
+ move "|" to l_sIndexTable\r
+ for l_j from 1 to l_iIndexValues\r
+ get token_value of (mTokens(current_object)) item l_j to l_iIndex\r
+ if (l_iIndex = l_i) calc (l_iIndex-1) to l_iIndex\r
+ append l_sIndexTable (string(l_iIndex)+"|")\r
+ loop\r
+ \r
+ set array_value of (mHash_array(current_object)) item l_iHash to l_sIndexTable\r
+ end\r
+ loop\r
+ \r
+ end\r
+ \r
+ forward send delete_item to current_object itemx\r
+ end_procedure\r
+\r
+ procedure matrix_sort integer itemy string order \r
+ local string l_sBuf l_sTmp l_sTmp2 l_sHash\r
+ local integer l_iX l_i l_j l_iMax l_iPoolMax l_iWidth l_iThrow l_iNumCount l_iHashOn l_iHash\r
+ \r
+ move (trim(uppercase(order))) to order\r
+ if ((order <> "ASCENDING") and (order <> "DESCENDING")) move "ASCENDING" to order\r
+ \r
+ object mSort_array is an array\r
+ end_object\r
+ object mClone_array is an array\r
+ end_object\r
+ \r
+ get c_iHashOn to l_iHashOn\r
+ get c_iWidth to l_iWidth\r
+ forward get item_count to l_iMax\r
+ \r
+ send delete_data to (mSort_array(current_object))\r
+ send delete_data to (mClone_array(current_object))\r
+ \r
+ if (l_iHashOn <> -1) begin\r
+ send delete_data to (mHash_array(current_object))\r
+ end\r
+ \r
+ move (l_iMax-1) to l_iMax \r
+ \r
+ for l_i from 0 to l_iMax\r
+ forward get array_value item l_i to l_sBuf\r
+ \r
+ send delete_data to (mTokens(current_object))\r
+ send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
+ get token_value of (mTokens(current_object)) item itemy to l_sTmp\r
+ \r
+ move 0 to l_iNumCount \r
+ for l_j from 1 to (length(l_sTmp))\r
+ if (((ascii(mid(l_sTmp,1,l_j))) >= 48) and ((ascii(mid(l_sTmp,1,l_j))) <= 57) or ((ascii(mid(l_sTmp,1,l_j))) = 46)) begin\r
+ increment l_iNumCount\r
+ end\r
+ loop\r
+ if ((length(l_sTmp) > 0) and (length(l_sTmp) = l_iNumCount)) begin\r
+ set array_value of (mSort_array(current_object)) item l_i to (number(l_sTmp))\r
+ end\r
+ else begin\r
+ if (length(l_sTmp) = 0) move (character(2)) to l_sTmp\r
+ set array_value of (mSort_array(current_object)) item l_i to l_sTmp\r
+ end\r
+ loop\r
+ \r
+ if (order = "ASCENDING") send sort_items to (mSort_array(current_object)) ascending\r
+ if (order = "DESCENDING") send sort_items to (mSort_array(current_object)) descending\r
+\r
+ move l_iMax to l_iPoolMax\r
+\r
+ for l_i from 0 to l_iMax\r
+ get array_value of (mSort_array(current_object)) item l_i to l_sTmp\r
+ if (l_sTmp = character(2)) move "" to l_sTmp\r
+ \r
+ for l_j from 0 to l_iPoolMax\r
+ // Ideally we'd change the next 3 lines for a lookup table instead\r
+ forward get array_value item l_j to l_sBuf\r
+ \r
+ send delete_data to (mTokens(current_object))\r
+ send set_string to (mTokens(current_object)) l_sBuf (character(1))\r
+ get token_value of (mTokens(current_object)) item itemy to l_sTmp2\r
+ \r
+ if (l_sTmp = l_sTmp2) begin\r
+ set array_value of (mClone_array(current_object)) item l_i to l_sBuf \r
+ \r
+ // On successful find shrink the sort pool here by moving max to l_j and decrementing max \r
+ forward get array_value item l_iPoolMax to l_sBuf\r
+ forward set array_value item l_j to l_sBuf\r
+ forward send delete_item to current_object l_iPoolMax\r
+ decrement l_iPoolMax \r
+ \r
+ // Remap hash\r
+ if (l_iHashOn <> -1) begin \r
+ get token_value of (mTokens(current_object)) item l_iHashOn to l_sHash\r
+ get find_hash of (mHash_table(current_object)) item l_sHash to l_iHash\r
+ get string_value of (mHash_array(current_object)) item l_iHash to l_sTmp\r
+ if not (l_sTmp contains ("|"+string(l_i)+"|")) begin\r
+ if (length(l_sTmp) = 0) move "|" to l_sTmp\r
+ append l_sTmp (string(l_i)+"|")\r
+ set array_value of (mHash_array(current_object)) item l_iHash to l_sTmp\r
+ end\r
+ end \r
+ goto dirty_speedup_jump\r
+ end\r
+ loop\r
+ dirty_speedup_jump:\r
+ loop\r
+ send delete_data to (mSort_array(current_object))\r
+ \r
+ for l_i from 0 to l_iMax\r
+ get array_value of (mClone_array(current_object)) item l_i to l_sBuf\r
+ forward set array_value item l_i to l_sBuf \r
+ loop\r
+ \r
+ send destroy_object to (mSort_array(current_object)) // Use "send request_destroy_object" to destroy object and all children.\r
+ send destroy_object to (mClone_array(current_object))\r
+ end_procedure\r
+ \r
+end_class\r
+\r
+// Rss 2.0 data class - RFC-822 dates used\r
+//\r
+// Send message methods:\r
+// init_rss - Initialise a new rss20 instance\r
+// init_img - Initialise the image to be used in the feed\r
+// add_item - Add an item to the feed\r
+// write_rss - Write the feed out to disk\r
+//\r
+// Set methods:\r
+// set_ttl - Set the TTL/refresh rate of the feed\r
+// set_contacts - Set admin contacts\r
+// \r
+// Get methods:\r
+//\r
+// Example usage:\r
+//\r
+// object test is an rss20\r
+// end_object\r
+//\r
+// move "" to link\r
+// move "" to url\r
+//\r
+// move "Google Maps" to title\r
+// move ("http:/"+"/www.google.com/maps") to link\r
+// move "Try out google maps" to desc\r
+// send init_rss to (test(current_object)) title link desc\r
+//\r
+// move ("http:/"+"/www.google.com/images/srpr/logo11w.png") to url\r
+// move 19 to x\r
+// move 41 to y\r
+// send init_img to (test(current_object)) url x y\r
+//\r
+// send set_ttl to (test(current_object)) 30\r
+// send set_contacts to (test(current_object)) "maps@google.com" "search@google.com"\r
+//\r
+// for i from 1 to 15\r
+// move "Test item " to title\r
+// append title i\r
+// move ("http:/"+"/www.google.com") to link\r
+// move "Test description " to desc\r
+// append desc i\r
+// move "NONE" to cat\r
+//\r
+// send add_item to (test(current_object)) title link desc cat (rssdate((now("date")),(now("longtime"))))\r
+// loop\r
+// send write_rss to (test(current_object)) "c:\google_maps.rss"\r
+\r
+class rss20 is a matrix\r
+ procedure construct_object string argc \r
+ forward send construct_object argc\r
+ property string c_rssTitle\r
+ property string c_rssLink\r
+ property string c_rssDesc\r
+ \r
+ property string c_imgTitle\r
+ property string c_imgUrl\r
+ property string c_imgLink\r
+ property string c_imgDesc\r
+ \r
+ property string c_webMaster\r
+ property string c_manEditor\r
+ \r
+ property integer c_imgx\r
+ property integer c_imgy\r
+ property integer c_ttl\r
+ \r
+ property integer c_itemCount\r
+ end_procedure\r
+ \r
+ procedure init_rss string rssTitle string rssLink string rssDesc\r
+ set c_rssTitle to rssTitle\r
+ set c_rssLink to rssLink\r
+ set c_rssDesc to rssDesc\r
+ set c_itemCount to 0\r
+ end_procedure\r
+ \r
+ procedure init_img string imgUrl integer imgx integer imgy\r
+ local string imgTitle imgLink imgDesc\r
+ get c_rssTitle to imgTitle\r
+ get c_rssLink to imgLink\r
+ get c_rssDesc to imgDesc\r
+ \r
+ set c_imgTitle to imgTitle\r
+ set c_imgUrl to imgUrl\r
+ set c_imgLink to imgLink\r
+ set c_imgDesc to imgDesc\r
+ set c_imgx to imgx\r
+ set c_imgy to imgy\r
+ end_procedure\r
+ \r
+ procedure set_ttl integer ttl\r
+ if (ttl > 0) set c_ttl to ttl\r
+ end_procedure\r
+ \r
+ procedure set_contacts string webMaster string manEditor\r
+ if (webMaster <> "") set c_webMaster to webMaster\r
+ if (manEditor <> "") set c_manEditor to manEditor\r
+ end_procedure\r
+ \r
+ procedure add_item string itemTitle string itemLink string itemDesc string itemCat string pubDate string itemGuID\r
+ local integer l_itemCount\r
+ get c_itemCount to l_itemCount\r
+ \r
+ // The standard says we should not have more than 15 items, but ignore this.\r
+ //if ((l_itemCount < 15) and (itemTitle <> "")) begin \r
+ if (itemTitle <> "") begin\r
+ increment l_itemCount\r
+ set c_itemCount to l_itemCount\r
+ \r
+ forward set matrix_value item l_itemCount item 0 to itemTitle\r
+ forward set matrix_value item l_itemCount item 1 to itemLink\r
+ forward set matrix_value item l_itemCount item 2 to itemDesc\r
+ forward set matrix_value item l_itemCount item 3 to itemCat\r
+ forward set matrix_value item l_itemCount item 4 to itemGuID\r
+ if ((pubDate <> "") and (pubDate <> "NOW")) forward set matrix_value item l_itemCount item 6 to pubDate\r
+ end\r
+ end_procedure\r
+ \r
+ procedure write_rss string rssFileName\r
+ local string l_rssTitle l_rssLink l_rssDesc l_imgTitle l_imgUrl l_imgLink l_itemTitle l_itemLink l_itemDesc l_itemCat l_sConflict l_property l_manEditor l_webMaster l_pubDate l_itemGuID l_itemCc\r
+ local integer l_imgx l_imgy l_itemcount l_i l_j l_iConflict l_iTtl\r
+ \r
+ get c_rssTitle to l_rssTitle\r
+ get c_rssLink to l_rssLink\r
+ get c_rssDesc to l_rssDesc\r
+ \r
+ get c_imgTitle to l_imgTitle\r
+ get c_imgUrl to l_imgUrl\r
+ get c_imgLink to l_imgLink\r
+ get c_manEditor to l_manEditor\r
+ get c_webMaster to l_webMaster\r
+ \r
+ get c_imgx to l_imgx\r
+ get c_imgy to l_imgy\r
+ get c_itemCount to l_itemCount\r
+ get c_ttl to l_iTtl\r
+ \r
+ direct_output channel default_file_channel rssFileName\r
+ writeln channel default_file_channel '<?xml version="1.0" ?>'\r
+ writeln channel default_file_channel '<?xml-stylesheet type="text/xsl" href="rss.xsl" media="screen"?>'\r
+ write channel default_file_channel '<rss version="2.0" xmlns:dc="http:/' '/purl.org/dc/elements/1.1/" xmlns:sy="http:/'\r
+ write channel default_file_channel '/purl.org/rss/1.0/modules/syndication/" xmlns:admin="http:/' '/webns.net/mvcb/" xmlns:rdf="http:/'\r
+ writeln channel default_file_channel '/www.w3.org/1999/02/22-rdf-syntax-ns#" xmlns:content="http:/' '/purl.org/rss/1.0/modules/content/">'\r
+ \r
+ // skipHours skipDays cloud - all currently not used\r
+ // Write out Channel\r
+ writeln channel default_file_channel ' <channel>'\r
+ writeln channel default_file_channel ' <title>' (trim(l_rssTitle)) '</title>'\r
+ writeln channel default_file_channel ' <link>' (trim(l_rssLink)) '</link>'\r
+ writeln channel default_file_channel ' <description>' (trim(l_rssDesc)) '</description>'\r
+ writeln channel default_file_channel ' <language>en-gb</language>'\r
+ writeln channel default_file_channel ' <generator>Df32func RSS Object Generator</generator>'\r
+ writeln channel default_file_channel ' <copyright>Copyright ' (trim(l_rssTitle)) ' (C) ' (now("date")) '</copyright>'\r
+ writeln channel default_file_channel ' <lastBuildDate>' (rssdate((now("date")),(now("longtime")))) '</lastBuildDate>'\r
+ writeln channel default_file_channel ' <pubDate>' (rssdate((now("date")),(now("longtime")))) '</pubDate>'\r
+ \r
+ if (l_manEditor <> "") writeln channel default_file_channel ' <managingEditor>' l_manEditor '</managingEditor>'\r
+ if (l_webMaster <> "") writeln channel default_file_channel ' <webMaster>' l_webMaster '</webMaster>'\r
+ if (l_iTtl <> 0) writeln channel default_file_channel ' <ttl>' l_iTtl '</ttl>' \r
+ \r
+ // Write out image\r
+ if ((l_imgUrl <> "") and (l_imgx > 0) and (l_imgy > 0)) begin\r
+ writeln channel default_file_channel ' <image>'\r
+ writeln channel default_file_channel ' <title>' (trim(l_imgTitle)) '</title>'\r
+ writeln channel default_file_channel ' <url>' (trim(l_imgUrl)) '</url>'\r
+ writeln channel default_file_channel ' <link>' (trim(l_imgLink)) '</link>'\r
+ writeln channel default_file_channel ' <height>' l_imgx '</height>'\r
+ writeln channel default_file_channel ' <width>' l_imgy '</width>'\r
+ writeln channel default_file_channel ' <description>' (trim(l_rssDesc)) '</description>'\r
+ writeln channel default_file_channel ' </image>'\r
+ end\r
+ \r
+ // Write out items\r
+ for l_i from 1 to l_itemCount\r
+ forward get matrix_value item l_i item 0 to l_itemTitle\r
+ forward get matrix_value item l_i item 1 to l_itemLink\r
+ forward get matrix_value item l_i item 2 to l_itemDesc\r
+ forward get matrix_value item l_i item 3 to l_itemCat\r
+ forward get matrix_value item l_i item 4 to l_itemGuID\r
+ forward get matrix_value item l_i item 5 to l_itemCc\r
+ forward get matrix_value item l_i item 6 to l_pubDate\r
+ \r
+\r
+ // Escape html in the description\r
+ move (replaces('"',l_itemDesc,""")) to l_itemDesc\r
+ move (replaces('<',l_itemDesc,"<")) to l_itemDesc\r
+ move (replaces('>',l_itemDesc,">")) to l_itemDesc\r
+ \r
+ writeln channel default_file_channel ' <item>'\r
+ writeln channel default_file_channel ' <title>' l_itemTitle '</title>'\r
+ writeln channel default_file_channel ' <link>' l_itemLink '</link>'\r
+ writeln channel default_file_channel ' <description>' l_itemDesc '</description>'\r
+ \r
+ if (l_itemGuID = "") begin\r
+ move 0 to l_iConflict\r
+ for l_j from 1 to (l_i-1)\r
+ forward get matrix_value item l_j item 1 to l_sConflict\r
+ if (l_sConflict = l_itemLink) increment l_iConflict\r
+ end\r
+ if (l_iConflict > 0) append l_iTemLink "#" l_iConflict\r
+ end\r
+ if (l_itemGuID <> "") append l_itemLink "#" l_itemGuID\r
+ \r
+ writeln channel default_file_channel ' <guid isPermaLink="false">' l_itemLink '</guid>'\r
+ if ((l_pubDate = "") or (l_pubDate = "NOW")) writeln channel default_file_channel ' <pubDate>' (rssdate((now("date")),(now("longtime")))) '</pubDate>'\r
+ else writeln channel default_file_channel ' <pubDate>' l_pubDate '</pubDate>'\r
+ writeln channel default_file_channel ' <category>' l_itemCat '</category>'\r
+ writeln channel default_file_channel ' </item>' \r
+ loop\r
+ \r
+ // Write out file/channel close\r
+ writeln channel default_file_channel ' </channel>'\r
+ writeln channel default_file_channel '</rss>' \r
+ close_output channel default_file_channel\r
+ \r
+ end_procedure \r
+ \r
+end_class\r
+\r
+\r
+// File list - Returns the contents of the DataFlex filelist\r
+//\r
+// In order to retrieve file attributes including the file number the file needs to be opened.\r
+//\r
+// Send message methods:\r
+// init - Initialize the matrix by reading the filelist\r
+//\r
+// Set methods:\r
+// <na>\r
+//\r
+// Get methods:\r
+// item_count - Return the count of filelist items\r
+// root_name - Get the root name of the file\r
+// display_name - Get the user friendly name of the file\r
+// system_name - Get the DataFlex friendly name of the table / file\r
+// valid - Non-zero if the DataFlex FD file exists\r
+//\r
+// Example usage:\r
+//\r
+// object test is a filelist\r
+// end_object\r
+\r
+// integer x i \r
+// string buf1 buf2 buf3 buf4\r
+// send init to (test(current_object)) "c:\df32" "filelist.cfg"\r
+// get item_count of test to x\r
+// \r
+// for i from 0 to x\r
+// get root_name of (test(current_object)) item i to buf1\r
+// get display_name of (test(current_object)) item i to buf2\r
+// get system_name of (test(current_object)) item i to buf3\r
+// get valid of (test(current_object)) item i to buf4\r
+// showln buf1 " " buf2 " " buf3 " " buf4\r
+// loop\r
+//\r
+\r
+class filelist is a matrix\r
+ procedure construct_object string argc \r
+ forward send construct_object argc\r
+ property string c_filelistDirectory\r
+ property string c_filelistName\r
+ property integer c_itemCount\r
+ end_procedure\r
+ \r
+ function item_count returns integer\r
+ local integer l_iItems\r
+ get c_itemCount to l_iItems\r
+ function_return l_iItems\r
+ end_function\r
+ \r
+ procedure init string filelistDirectory string filelistName\r
+ local integer l_iFileNumber\r
+ local string l_sRootName l_sUserDisplayName l_sFileName l_sHead l_sUrn\r
+ \r
+ move 0 to l_iFileNumber\r
+ if (filelistName = "") begin\r
+ move "filelist.cfg" to filelistName\r
+ end\r
+ \r
+ set c_filelistDirectory to filelistDirectory\r
+ set c_filelistName to filelistName\r
+ \r
+ direct_input channel default_file_channel (filelistDirectory+filelistName)\r
+ read_block l_sHead 256 \r
+ while not (seqeof) \r
+ //Block of 128 split 41\33\54\r
+ read_block channel default_file_channel l_sRootName 41\r
+ read_block channel default_file_channel l_sUserDisplayName 33\r
+ read_block channel default_file_channel l_sFileName 54\r
+\r
+ move filelistDirectory to l_sUrn\r
+ append l_sUrn (trim(cstring(l_sFileName))) ".FD"\r
+\r
+ if ((trim(cstring(l_sFileName))) <> "") begin\r
+ forward set matrix_value item l_iFileNumber item 0 to (trim(cstring(l_sRootName)))\r
+ forward set matrix_value item l_iFileNumber item 1 to (trim(cstring(l_sUserDisplayName)))\r
+ forward set matrix_value item l_iFileNumber item 2 to (trim(cstring(l_sFileName)))\r
+ if (does_exist(l_sUrn) = 1) begin\r
+ forward set matrix_value item l_iFileNumber item 3 to 1\r
+ end\r
+ else begin\r
+ forward set matrix_value item l_iFileNumber item 3 to 0\r
+ end\r
+ increment l_iFileNumber\r
+ end\r
+ loop \r
+ close_input channel default_file_channel\r
+ \r
+ set c_itemCount to l_iFileNumber\r
+ end_procedure\r
+ \r
+ function root_name integer itemx returns integer\r
+ local string l_sBuf\r
+ forward get matrix_value item itemx item 0 to l_sBuf\r
+ function_return l_sBuf\r
+ end_function\r
+ \r
+ function display_name integer itemx returns integer\r
+ local string l_sBuf\r
+ forward get matrix_value item itemx item 1 to l_sBuf\r
+ function_return l_sBuf\r
+ end_function\r
+\r
+ function system_name integer itemx returns integer\r
+ local string l_sBuf\r
+ forward get matrix_value item itemx item 2 to l_sBuf\r
+ function_return l_sBuf\r
+ end_function\r
+ \r
+ function valid integer itemx returns integer\r
+ local integer l_iTmp\r
+ forward get matrix_value item itemx item 3 to l_iTmp\r
+ function_return l_iTmp\r
+ end_function\r
+end_class\r
+\r
+\r
+//Class for reading unicode files when we know they have low ASCII only\r
+//\r
+// Example Usage:\r
+//\r
+// object test is a UnicodeReader\r
+// end_object\r
+//\r
+// local string asciiline\r
+// local integer error i count channelx\r
+//\r
+// send open_file to (test(current_object)) 1 "c:\test_unicode.txt"\r
+// while not (seqeof)\r
+// get readline of (test(current_object)) 1 to asciiline\r
+// showln asciiline\r
+// loop\r
+// send close_file to (test(current_object)) 1\r
+\r
+class UnicodeReader is an array\r
+ procedure construct_object integer argc\r
+ forward send construct_object\r
+ property integer c_iSizeBytes public argc\r
+ property integer c_iBytesOn \r
+ property integer c_iOpen\r
+ property string c_sPeek\r
+ set c_iOpen to 0\r
+ end_procedure\r
+ \r
+ procedure open_file integer l_iChan string l_sFile\r
+ local integer l_iSizeBytes l_iOpen\r
+ local string l_sTmp l_sBom\r
+ get c_iOpen to l_iOpen\r
+ \r
+ move (trim(l_sFile)) to l_sFile\r
+ if ((l_sFile <> "") and (l_iOpen = 0)) begin \r
+ move (file_size_bytes(l_sFile)-2) to l_iSizeBytes\r
+ direct_input channel l_iChan l_sFile\r
+ read_block channel l_iChan l_sTmp 1\r
+ if (ascii(l_sTmp) < 254) begin\r
+ set_channel_position l_iChan to 0\r
+ end\r
+ else begin\r
+ read_block channel l_iChan l_sTmp 1\r
+ end\r
+ \r
+ set c_iSizeBytes to l_iSizeBytes\r
+ set c_iBytesOn to 0\r
+ set c_iOpen to 1\r
+ end\r
+ end_procedure\r
+ \r
+ procedure close_file integer l_iChan\r
+ local integer l_iOpen\r
+ \r
+ get c_iOpen to l_iOpen\r
+ if (l_iOpen = 0) begin \r
+ close_input channel l_iChan\r
+ end\r
+ set c_iOpen to 0\r
+ end_procedure\r
+ \r
+ function readline global integer l_iChan returns string\r
+ local string l_sReturn l_sTmp\r
+ local integer l_iBytesOn l_iSizeBytes\r
+ \r
+ move "" to l_sTmp\r
+ move "" to l_sReturn\r
+ get c_iSizeBytes to l_iSizeBytes\r
+ get c_iBytesOn to l_iBytesOn\r
+ \r
+ while ((l_sTmp <> character(13)) and (l_iBytesOn < l_iSizeBytes))\r
+ read_block channel l_iChan l_sTmp 1\r
+ increment l_iBytesOn\r
+ if ((l_sTmp <> character(13)) and (l_sTmp <> character(10)) and (l_sTmp <> character(0))) begin\r
+ move (l_sReturn+l_sTmp) to l_sReturn\r
+ end\r
+ loop\r
+ \r
+ function_return l_sReturn\r
+ end_function\r
+ \r
+end_class\r
+\r
+// ListDirectory class - provides a directory listing\r
+//\r
+// Send message methods:\r
+// delete_data - Clear the listing\r
+// list_files - Read the directory listing into the object\r
+// sort_files - Sort the file list on a particular property\r
+//\r
+// Set methods:\r
+// <na>\r
+//\r
+// Get methods:\r
+// file_count - Return the count of files in the list\r
+// filename - Get the base name of a file in the list\r
+// filesize - Get the size of a file in the list\r
+// file_created - Get the created timestamp of the file\r
+// file_modified - Get the modification timestamp of the file\r
+// file_accessed - Get the last access timestamp of the file\r
+//\r
+// Example usage:\r
+//\r
+// object test is a ListDirectory\r
+// end_object\r
+// \r
+// integer i x\r
+// string buf tmp\r
+// \r
+// send delete_data to test\r
+// send list_files to (test(current_object)) "c:\*"\r
+// get file_count of (test(current_object)) to x\r
+// send sort_files to test "file_accesed" "ASCENDING"\r
+// \r
+// for i from 0 to x\r
+// get filename of (test(current_object)) item i to tmp\r
+// get filesize of (test(current_object)) item i to buf\r
+// append tmp "," buf\r
+// move (pad(tmp,35)) to tmp\r
+// get file_created of (test(current_object)) item i to buf\r
+// append tmp "," buf\r
+// get file_modified of (test(current_object)) item i to buf\r
+// append tmp "," buf\r
+// get file_accessed of (test(current_object)) item i to buf\r
+// append tmp "," buf\r
+// showln tmp\r
+// loop \r
+\r
+class ListDirectory is a matrix\r
+ procedure construct_object integer argc\r
+ forward send construct_object argc\r
+ property integer c_iFiles public argc\r
+ end_procedure\r
+ \r
+ procedure delete_data\r
+ set c_iFiles to 0\r
+ forward send delete_data\r
+ end_procedure\r
+ \r
+ procedure list_files string sPathName\r
+ local string sWin32FindData sLine sLast sComment sFileName sModifiedDate sAccessDate sCreationDate k sLastFile\r
+ local integer l_01iResult iFileSize l_iFiles\r
+ local pointer pT5 pT6\r
+ local handle hFile\r
+ local dword dwFileSizeHigh dwFileSizeLow dwHighDateTime dwLowDateTime\r
+\r
+ forward send delete_data\r
+ \r
+ zerotype _WIN32_FIND_DATA to sWin32FindData\r
+ getaddress of sWin32FindData to pT5\r
+ move (trim(sPathName)) to sPathName\r
+ getaddress of sPathName to pT6\r
+ move (FindFirstFile(pT6, pT5)) to hFile\r
+ //if (hFile = -1) showln "Invalid file handle!"\r
+\r
+ move -1 to l_iFiles\r
+ repeat \r
+ // FileName\r
+ getbuff_String from sWin32FindData at WIN32_FIND_DATA.cFileName to sFileName\r
+ if ((sFileName <> ".") and (sFileName <> "..") and (sFileName <> "")) begin\r
+ increment l_iFiles\r
+\r
+ // FileSize\r
+ getbuff from sWin32FindData at WIN32_FIND_DATA.nFileSizeHigh to dwFileSizeHigh\r
+ getbuff from sWin32FindData at WIN32_FIND_DATA.nFileSizeLow to dwFileSizeLow\r
+ moveint ((dwFileSizeHigh*MaxDword)+dwFileSizeLow) to iFileSize\r
+\r
+ // File Modified Time\r
+ getbuff from sWin32FindData at WIN32_FIND_DATA.ftLastWriteLowDateTime to dwLowDateTime\r
+ getbuff from sWin32FindData at WIN32_FIND_DATA.ftLastWriteHighDateTime to dwHighDateTime\r
+ move (convert_date_format(dwLowDateTime, dwHighDateTime)) to sModifiedDate\r
+\r
+ // File Accessed Time\r
+ getbuff from sWin32FindData at WIN32_FIND_DATA.ftLastAccessLowDateTime to dwLowDateTime\r
+ getbuff from sWin32FindData at WIN32_FIND_DATA.ftLastAccessHighDateTime to dwHighDateTime\r
+ move (convert_date_format(dwLowDateTime, dwHighDateTime)) to sAccessDate\r
+\r
+ // File Creation Time\r
+ getbuff from sWin32FindData at WIN32_FIND_DATA.ftCreationLowDateTime to dwLowDateTime\r
+ getbuff from sWin32FindData at WIN32_FIND_DATA.ftCreationHighDateTime to dwHighDateTime\r
+ move (convert_date_format(dwLowDateTime, dwHighDateTime)) to sCreationDate\r
+\r
+ move (cstring(sFileName)) to sFileName\r
+ forward set matrix_value item l_iFiles item 1 to sFileName\r
+ forward set matrix_value item l_iFiles item 2 to iFileSize\r
+ forward set matrix_value item l_iFiles item 3 to (integer(date(sModifiedDate)))\r
+ forward set matrix_value item l_iFiles item 4 to (integer(date(sAccessDate)))\r
+ forward set matrix_value item l_iFiles item 5 to (integer(date(sCreationDate)))\r
+ end\r
+ zerotype _WIN32_FIND_DATA to sWin32FindData\r
+ move (FindNextFile(hFile, pT5)) to l_01iResult\r
+ until (l_01iResult = 0)\r
+ move (FindClose(hFile)) to l_01iResult\r
+\r
+ set c_iFiles to l_iFiles\r
+ end_procedure\r
+\r
+ function filename integer itemx returns string\r
+ local string l_sBuf\r
+ move "" to l_sBuf\r
+ forward get matrix_value item itemx item 1 to l_sBuf\r
+ function_return l_sBuf\r
+ end_function \r
+ \r
+ function filesize integer itemx returns integer\r
+ local integer l_iBuf \r
+ forward get matrix_value item itemx item 2 to l_iBuf\r
+ function_return l_iBuf\r
+ end_function\r
+ \r
+ function file_modified integer itemx returns date\r
+ local integer l_iBuf \r
+ forward get matrix_value item itemx item 3 to l_iBuf\r
+ function_return (date(l_iBuf))\r
+ end_function\r
+ \r
+ function file_accessed integer itemx returns date\r
+ local integer l_iBuf \r
+ forward get matrix_value item itemx item 4 to l_iBuf\r
+ function_return (date(l_iBuf))\r
+ end_function \r
+ \r
+ function file_created integer itemx returns date\r
+ local integer l_iBuf \r
+ forward get matrix_value item itemx item 5 to l_iBuf\r
+ function_return (date(l_iBuf))\r
+ end_function\r
+ \r
+ procedure sort_files string sField string sOrder\r
+ local integer l_iSort\r
+ if ((sOrder <> "ASCENDING") and (sOrder <> "DESCENDING")) move "ASCENDING" to sOrder\r
+ move 1 to l_iSort\r
+ if (sField = "filename") move 1 to l_iSort\r
+ if (sField = "filesize") move 2 to l_iSort\r
+ if (sField = "file_modified") move 3 to l_iSort\r
+ if (sField = "file_accessed") move 4 to l_iSort\r
+ if (sField = "file_created") move 5 to l_iSort\r
+ forward send matrix_sort l_iSort sOrder\r
+ end_procedure\r
+ \r
+ function file_count returns integer\r
+ local integer l_iFiles\r
+ get c_iFiles to l_iFiles\r
+ function_return l_iFiles\r
+ end_function\r
+end_class\r
+\r
+// ProcessList class - provides a listing of running processes\r
+//\r
+// Experimental; all aspects reading process info appear to fail, it can\r
+// be useful however to check if a particular process pid is still running.\r
+//\r
+// Send message methods:\r
+// delete_data - Clear the listing\r
+// init_processes - Read the process list table\r
+//\r
+// Set methods:\r
+// <na>\r
+//\r
+// Get methods:\r
+// get_process_id - Return the PID of a particular process\r
+// process_count - Return count of processes in the list\r
+// process_handle - BROKEN\r
+//\r
+// Example usage:\r
+//\r
+// object test is an ProcessList\r
+// end_object\r
+// \r
+// integer i x id hx\r
+// \r
+// send init_processes to test\r
+// get process_count of (test(current_object)) to x\r
+// showln "Processes in list = " x\r
+// \r
+// for i from 0 to x\r
+// get process_id of (test(current_object)) item i to id\r
+// loop\r
+//\r
+class ProcessList is an array\r
+ procedure construct_object integer argc\r
+ forward send construct_object\r
+ property integer c_iProcesses public argc\r
+ end_procedure\r
+ \r
+ procedure delete_data\r
+ set c_iProcesses to 0\r
+ forward send delete_data\r
+ end_procedure\r
+ \r
+ procedure init_processes\r
+ local string l_sProcesses l_sStructBytesBack l_sBuf l_sModules\r
+ local integer l_iThrow l_iBytes l_iBytes2 l_iBytesBack l_iBytesBack2 l_i l_j l_iPid l_iMid l_iProcesses\r
+ local pointer l_pProcesses l_pBytesBack l_pBytesBack2 l_pModules\r
+ local handle l_hProcess\r
+\r
+ move (1024*10) to l_iBytes \r
+ zerostring l_iBytes to l_sProcesses\r
+ move 0 to l_iBytesBack\r
+ move 0 to l_iProcesses\r
+ forward send delete_data\r
+\r
+ getAddress of l_sProcesses to l_pProcesses \r
+ zerotype _STRUCTBYTESBACK to l_sStructBytesBack\r
+ getaddress of l_sStructBytesBack to l_pBytesBack\r
+\r
+ move (EnumProcesses(l_pProcesses,l_iBytes,l_pBytesBack)) to l_iThrow\r
+\r
+ getbuff from l_sStructBytesBack at STRUCTBYTESBACK.integer0 to l_iBytesBack\r
+\r
+ if (mod(l_iBytesBack,4) = 0) begin\r
+ for l_i from 1 to (l_iBytesBack/4)\r
+ move (left(l_sProcesses,4)) to l_sBuf\r
+ move (mid(l_sProcesses,(length(l_sProcesses)-4),5)) to l_sProcesses\r
+ getbuff from l_sBuf at PROCESSARRAY.arrayItem to l_iPid \r
+ move (OpenProcess(PROCESS_QUERY_INFORMATION, 0,l_iPid)) to l_hProcess\r
+ \r
+ // Fails to open the process for more info here unfortunately\r
+ //showln "LERR=" (get_last_error_detail(GetLastError())) " " l_ipid\r
+\r
+ move 1024 to l_iBytes2\r
+ zerostring l_iBytes2 to l_sModules\r
+ getAddress of l_sModules to l_pModules\r
+ zerotype _STRUCTBYTESBACK to l_sStructBytesBack\r
+ getaddress of l_sStructBytesBack to l_pBytesBack2\r
+\r
+ move (EnumProcessModules(l_hProcess,l_pModules,l_iBytes2,l_pBytesBack2)) to l_iThrow\r
+ getbuff from l_sStructBytesBack at STRUCTBYTESBACK.integer0 to l_iBytesBack2\r
+ \r
+ increment l_iProcesses \r
+ forward set array_value item (l_i-1) to (string(l_iPid)+"|"+string(l_hProcess))\r
+\r
+ if (mod(l_iBytesBack2,4) = 0) begin\r
+ for l_j from 1 to (l_iBytesBack2/4)\r
+ move (left(l_sModules,4)) to l_sBuf\r
+ move (mid(l_sModules,(length(l_sModules)-4),5)) to l_sModules\r
+ getbuff from l_sBuf at PROCESSARRAY.arrayItem to l_iMid\r
+ loop\r
+ end\r
+ move (CloseHandle(l_hProcess)) to l_iThrow\r
+ loop\r
+ \r
+ set c_iTokenOn to 0\r
+ set c_iProcesses to l_iProcesses\r
+ end\r
+ end_procedure\r
+\r
+ function process_id integer itemx returns integer\r
+ local string l_sBuf \r
+ forward get array_value item itemx to l_sBuf\r
+ function_return (integer(left(l_sBuf,pos("|",l_sBuf)-1)))\r
+ end_function \r
+\r
+ // There's not much point to this as we couldn't get the handle because OpenProcess failed.\r
+ function process_handle integer itemx returns integer\r
+ local string l_sBuf \r
+ forward get array_value item itemx to l_sBuf\r
+ function_return (integer(right(l_sBuf,length(l_sBuf)-pos("|",l_sBuf))))\r
+ end_function \r
+ \r
+ function process_count returns integer\r
+ local integer l_iProcesses\r
+ get c_iProcesses to l_iProcesses\r
+ function_return l_iProcesses\r
+ end_function\r
+end_class\r
--- /dev/null
+//-------------------------------------------------------------------------\r
+// date.inc\r
+// This file contains some DataFlex 3.2 Console Mode functions\r
+// to provide extended date manipulation capabilities.\r
+//\r
+// This file is to be included in df32func.mk\r
+//\r
+// Copyright (c) 2006-2009, glyn@8kb.co.uk\r
+// \r
+// df32func/date.inc\r
+//-------------------------------------------------------------------------\r
+\r
+//-------------------------------------------------------------------------\r
+// Functions\r
+//-------------------------------------------------------------------------\r
+\r
+// Returns day of the week as an integer score 1 = monday 7 = sunday\r
+function get_day_score global date argv returns integer\r
+ local integer l_01tmpInt\r
+ \r
+ calc (mod(argv,7)) to l_01tmpInt\r
+ if (l_01tmpInt < 0) calc (l_01tmpInt+7) to l_01tmpInt\r
+ \r
+ case begin\r
+ case (l_01tmpInt = 3) move 1 to l_01tmpInt\r
+ case break\r
+ case (l_01tmpInt = 4) move 2 to l_01tmpInt\r
+ case break\r
+ case (l_01tmpInt = 5) move 3 to l_01tmpInt\r
+ case break\r
+ case (l_01tmpInt = 6) move 4 to l_01tmpInt\r
+ case break\r
+ case (l_01tmpInt = 0) move 5 to l_01tmpInt\r
+ case break\r
+ case (l_01tmpInt = 1) move 6 to l_01tmpInt\r
+ case break\r
+ case (l_01tmpInt = 2) move 7 to l_01tmpInt\r
+ case break\r
+ case end\r
+ \r
+ function_return l_01tmpInt\r
+end_function\r
+\r
+// Returns the current day as a string from the date\r
+function get_day global date argv returns string\r
+ local integer l_iDay\r
+ local string l_sDay\r
+\r
+ move (get_day_score(argv)) to l_iDay\r
+ \r
+ case begin\r
+ case (l_iDay = 1) move "Monday" to l_sDay\r
+ case break\r
+ case (l_iDay = 2) move "Tuesday" to l_sDay\r
+ case break\r
+ case (l_iDay = 3) move "Wednesday" to l_sDay\r
+ case break\r
+ case (l_iDay = 4) move "Thursday" to l_sDay\r
+ case break\r
+ case (l_iDay = 5) move "Friday" to l_sDay\r
+ case break\r
+ case (l_iDay = 6) move "Saturday" to l_sDay\r
+ case break\r
+ case (l_iDay = 7) move "Sunday" to l_sDay\r
+ case break\r
+ case end\r
+\r
+ function_return l_sDay\r
+end_function\r
+\r
+// Returns the current month as a string from the date\r
+function get_month global date argv returns string\r
+ local integer l_iMonth\r
+ local string l_sMonth\r
+\r
+ calc ((integer(mid(argv, 2, 4)))-1) to l_iMonth\r
+ case begin\r
+ case (l_iMonth = 0) move "January" to l_sMonth\r
+ case (l_iMonth = 1) move "February" to l_sMonth\r
+ case (l_iMonth = 2) move "March" to l_sMonth\r
+ case (l_iMonth = 3) move "April" to l_sMonth\r
+ case (l_iMonth = 4) move "May" to l_sMonth\r
+ case (l_iMonth = 5) move "June" to l_sMonth\r
+ case (l_iMonth = 6) move "July" to l_sMonth\r
+ case (l_iMonth = 7) move "August" to l_sMonth\r
+ case (l_iMonth = 8) move "September" to l_sMonth\r
+ case (l_iMonth = 9) move "October" to l_sMonth\r
+ case (l_iMonth = 10) move "November" to l_sMonth\r
+ case (l_iMonth = 11) move "December" to l_sMonth\r
+ case end\r
+\r
+ function_return l_sMonth\r
+end_function\r
+\r
+// Returns the current day of the month\r
+function get_day_of global date argv returns string\r
+ local string l_01tmpStr\r
+ local integer l_01tmpInt\r
+\r
+ move (mid(argv, 2, 1)) to l_01tmpInt\r
+ move "th" to l_01tmpStr\r
+ if (mid(argv, 1, 1)) ne 1 begin\r
+ if (mid(argv, 1, 2)) eq 1 move "st" to l_01tmpStr\r
+ if (mid(argv, 1, 2)) eq 2 move "nd" to l_01tmpStr\r
+ if (mid(argv, 1, 2)) eq 3 move "rd" to l_01tmpStr\r
+ end\r
+\r
+ function_return l_01tmpStr\r
+end_function\r
+\r
+// Returns a string representing the full date e.g. "Friday 31st July 2009"\r
+function fulldate global date argv returns string\r
+ local string l_01tmpStr l_02tmpStr \r
+ local integer l_01tmpInt l_01arrayindex\r
+\r
+ move (get_day(argv)) to l_02tmpStr\r
+ move (mid(argv, 2, 1)) to l_01tmpInt\r
+ move "th" to l_01tmpStr\r
+ if (mid(argv, 1, 1)) ne 1 begin\r
+ if (mid(argv, 1, 2)) eq 1 move "st" to l_01tmpStr\r
+ if (mid(argv, 1, 2)) eq 2 move "nd" to l_01tmpStr\r
+ if (mid(argv, 1, 2)) eq 3 move "rd" to l_01tmpStr\r
+ end\r
+ append l_02tmpStr " " l_01tmpInt (trim(l_01tmpStr)) " "\r
+ move (get_month(argv)) to l_01tmpStr\r
+ append l_02tmpStr (trim(l_01tmpStr)) " " (trim(mid(argv, 4, 7)))\r
+\r
+ function_return l_02tmpStr\r
+end_function\r
+\r
+// Returns a string representing the date in short form e.g. "31 July 2009"\r
+function shortdate global date argv returns string\r
+ local string l_01tmpStr\r
+\r
+ move "" to l_01tmpStr\r
+ append l_01tmpStr (mid(argv,2,1)) " " (get_month(argv)) " " (mid(argv,4,7))\r
+ \r
+ function_return l_01tmpStr\r
+end_function\r
+\r
+// Returns the current time and or date in different formats\r
+function now global string argv returns string\r
+ local string l_01tmpStr l_02tmpStr\r
+ local date l_01nowDate\r
+ local number l_01nowTime l_02nowTime l_03nowTime l_01nowSecs\r
+ sysdate l_01nowDate\r
+ calc ((number(strlen))+((number(strmark))/100)) to l_01nowTime\r
+ move "" to l_01tmpStr\r
+ if ((trim(lowercase(argv))) = "time") append l_01tmpStr (string(decround(l_01nowTime,2)))\r
+ if (((trim(lowercase(argv))) = "longtime") or ((trim(lowercase(argv))) = "timestamp")) begin\r
+ sysdate l_01nowDate l_01nowTime l_02nowTime l_03nowTime\r
+ move "" to l_01tmpStr\r
+ if ((trim(lowercase(argv))) = "timestamp") append l_01tmpStr l_01nowDate " "\r
+ if (l_01nowTime < 10) append l_01tmpStr 0\r
+ append l_01tmpStr l_01nowTime ":"\r
+ if (l_02nowTime < 10) append l_01tmpStr 0\r
+ append l_01tmpStr l_02nowTime ":"\r
+ if (l_03nowTime < 10) append l_01tmpStr 0\r
+ append l_01tmpStr l_03nowTime\r
+ end\r
+ if ((trim(lowercase(argv))) = "seconds") begin\r
+ sysdate l_01nowDate l_01nowTime l_02nowTime l_03nowTime\r
+ move (string((l_01nowTime*3600)+(l_02nowTime*60)+l_03nowTime)) to l_01tmpStr \r
+ end\r
+ if ((trim(lowercase(argv))) = "date") append l_01tmpStr l_01nowDate\r
+ if ((trim(lowercase(argv))) = "shorttimestamp") append l_01tmpStr l_01nowDate "," (string(decround(l_01nowTime,2)))\r
+ if ((trim(lowercase(argv))) = "longtimestamp") begin\r
+ append l_01tmpStr (fulldate(l_01nowDate)) " at "\r
+ if (l_01nowTime > 12) append l_01tmpStr (string(decround(l_01nowTime-12,2))) "PM"\r
+ if (l_01nowTime <= 12) append l_01tmpStr (string(decround(l_01nowTime,2))) "AM"\r
+ end\r
+ \r
+ function_return l_01tmpStr\r
+end_function\r
+\r
+// Return a date and time in the RSS standard format\r
+function rssdate global date argv string argv2 returns string\r
+ local string l_01tmpStr\r
+\r
+ move "" to l_01tmpStr\r
+ append l_01tmpStr (left((get_day(argv)),3)) ", " (mid(argv,2,1)) " " (left((get_month(argv)),3)) " " (mid(argv,4,7)) " " (trim(argv2)) " GMT"\r
+ move (uppercase(l_01tmpStr)) to l_01tmpStr\r
+\r
+ function_return l_01tmpStr\r
+end_function\r
+\r
+// Retuns a date in the format CCYYMMDD\r
+function cymd global date argv returns string\r
+ local string l_01tmpStr\r
+ \r
+ move (mid(argv,4,7)) to l_01tmpStr\r
+ append l_01tmpStr (mid(argv,2,4)) (mid(argv,2,1))\r
+ \r
+ function_return l_01tmpStr\r
+end_function\r
+\r
+// Retuns a date in the format CCYY-MM-DD\r
+function sqldate global date argv returns string\r
+ local string l_01tmpStr\r
+ move "" to l_01tmpStr\r
+ \r
+ if (argv <> "") begin\r
+ move (mid(argv,4,7)) to l_01tmpStr\r
+ append l_01tmpStr "-" (mid(argv,2,4)) "-" (mid(argv,2,1))\r
+ end\r
+ function_return l_01tmpStr\r
+end_function\r
+\r
+// Retuns a timestamp in the format CCYY-MM-DD HH:mm:SS\r
+function sqltimestamp global date argv integer argv2 integer argv3 integer argv4 returns string\r
+ local string l_01tmpStr\r
+ move "" to l_01tmpStr\r
+ \r
+ if ((argv <> "") and ((argv2 >= 0) and (argv2 <= 23)) and ((argv3 >= 0) and (argv3 <= 59)) and ((argv4 >= 0) and (argv4 <= 59))) begin\r
+ move (mid(argv,4,7)) to l_01tmpStr\r
+ append l_01tmpStr "-" (mid(argv,2,4)) "-" (mid(argv,2,1)) " " (zeropad(argv2,2)) ":" (zeropad(argv3,2)) ":" (zeropad(argv4,2))\r
+ end\r
+ \r
+ function_return l_01tmpStr\r
+end_function\r
+\r
+// Retuns a timestamp in the format DD/MM/CCYY HH:mm:SS\r
+function dftimestamp global date argv integer argv2 integer argv3 integer argv4 returns string\r
+ local string l_01tmpStr\r
+ move "" to l_01tmpStr\r
+ \r
+ if ((argv <> "") and ((argv2 >= 0) and (argv2 <= 23)) and ((argv3 >= 0) and (argv3 <= 59)) and ((argv4 >= 0) and (argv4 <= 59))) begin\r
+ move "" to l_01tmpStr\r
+ append l_01tmpStr argv " " (zeropad(argv2,2)) ":" (zeropad(argv3,2)) ":" (zeropad(argv4,2))\r
+ end\r
+ \r
+ function_return l_01tmpStr\r
+end_function\r
+\r
+// Returns date or time as a string out of a dateTime struct\r
+function sqldatetime global string argv string argv2 returns string\r
+ local string l_sResult\r
+ \r
+ move (trim(argv)) to argv\r
+ move (trim(uppercase(argv2))) to argv2\r
+ \r
+ if (argv2 = "DATE") begin\r
+ move (mid(argv,2,9)) to l_sResult\r
+ append l_sResult "/" (mid(argv,2,6)) "/" (mid(argv,4,1))\r
+ end\r
+ if (argv2 = "TIME") begin\r
+ move (right(argv,12)) to l_sresult\r
+ end\r
+ \r
+ function_return l_sResult\r
+end_function\r
+\r
+// Returns date or timestamp as a string out of a dateTime struct\r
+function sqltimestampformat global string argv string argv2 returns string\r
+ local string l_sResult\r
+ \r
+ move (trim(argv)) to argv\r
+ move (trim(uppercase(argv2))) to argv2\r
+ \r
+ if (argv2 = "DATE") begin\r
+ move (mid(argv,2,9)) to l_sResult\r
+ append l_sResult "/" (mid(argv,2,6)) "/" (mid(argv,4,1))\r
+ end\r
+ if (argv2 = "TIME") begin\r
+ move (right(argv,length(argv)-pos(" ", argv))) to l_sresult\r
+ end\r
+ \r
+ function_return l_sResult\r
+end_function\r
+\r
+// Returns last day of month as a date\r
+function last_day_of_month global integer month integer year returns date\r
+ local date l_dDate\r
+ if (month = 12) begin\r
+ calc (year+1) to year\r
+ move 1 to month\r
+ end\r
+ else begin\r
+ calc (month+1) to month\r
+ end\r
+ \r
+ move (('01/'+string(month)+'/'+string(year))-1) to l_dDate\r
+ \r
+ function_return l_dDate\r
+end_function\r
+\r
+// Returns a posix timestamp when supplied with a date and numeric values\r
+// for hour, minutes ,seconds and milliseconds: (date,hr,min,sec,millisec)\r
+//\r
+// Also see timestamp_to_posix and posix_to_timestamp in timestamp.inc\r
+function posixtime global date argv number argv2 number argv3 number argv4 number argv5 returns number\r
+ local number l_posix\r
+ \r
+ // Leap seconds not coded\r
+ calc (((integer(argv))-(integer(date("01/01/1970"))))*86400) to l_posix\r
+ calc (((((argv2*60)+argv3)*60)+argv4)+(argv5/1000)+l_posix) to l_posix\r
+ \r
+ function_return l_posix\r
+end_function\r
+\r
+// Returns a comma separated string representing a timestamp (date,hr,min,sec,millisec)\r
+// when supplied with a posix time value.\r
+function posixtime_reverse global number argv returns string\r
+ local date l_date\r
+ local number l_subt \r
+ local integer l_hr l_min l_sec l_msec\r
+ local string l_posix_reverse\r
+ \r
+ // Leap seconds not coded\r
+ calc ((argv/86400)+(integer(date("01/01/1970")))) to l_date\r
+ calc (argv-(((integer(l_date))-(integer(date("01/01/1970"))))*86400)) to l_subt\r
+ calc (l_subt/3600) to l_hr\r
+ calc ((l_subt-(l_hr*3600))/60) to l_min\r
+ calc (l_subt-(((l_hr*60)+l_min)*60)) to l_sec\r
+ calc ((l_subt-((((l_hr*60)+l_min)*60)+l_sec))*1000) to l_msec\r
+ \r
+ move l_date to l_posix_reverse\r
+ append l_posix_reverse "," l_hr "," l_min "," l_sec "," l_msec\r
+ \r
+ function_return l_posix_reverse\r
+end_function\r
+\r
+// Returns 0 until the timeout in seconds value passed is exceeded\r
+// when it returns 1.\r
+//\r
+// Relies on the value of global integer "g_nRuntime_entry";\r
+// the only way to use more than once is to reset that global to 0\r
+// by calling runtime_timeout_reset.\r
+function runtime_timeout global integer argv returns integer\r
+ local integer l_iTimeout\r
+ local number l_nHour l_nMinute l_nSec l_nRuntime_now\r
+ local date l_dToday\r
+ \r
+ sysdate l_dToday l_nHour l_nMinute l_nSec\r
+ move 0 to l_iTimeout\r
+ \r
+ if (argv <> 0) begin\r
+ if (g_nRuntime_entry = 0) begin\r
+ move (posixTime(l_dToday,l_nHour,l_nMinute,l_nSec,0)) to g_nRuntime_entry\r
+ end\r
+ \r
+ move (posixTime(l_dToday,l_nHour,l_nMinute,l_nSec,0)) to l_nRuntime_now\r
+ \r
+ if ((l_nRuntime_now - g_nRuntime_entry) > argv) begin\r
+ move 1 to l_iTimeout\r
+ end\r
+ end\r
+ \r
+ function_return l_iTimeout\r
+end_function \r
+\r
+// Resets the value of global integer "g_nRuntime_entry" as used by\r
+// runtime_timeout\r
+function runtime_timeout_reset global returns integer\r
+ move 0 to g_nRuntime_entry\r
+ function_return 0\r
+end_function \r
+\r
+// Returns the time left in seconsd until runtime_timeout is exceeded.\r
+function runtime_timeout_left global returns integer\r
+ local number l_nHour l_nMinute l_nSec l_nRuntime_now\r
+ local date l_dToday\r
+\r
+ sysdate l_dToday l_nHour l_nMinute l_nSec\r
+ move (posixTime(l_dToday,l_nHour,l_nMinute,l_nSec,0)) to l_nRuntime_now \r
+ \r
+ function_return (l_nRuntime_now - g_nRuntime_entry)\r
+end_function \r
--- /dev/null
+//-------------------------------------------------------------------------\r
+// depmacro.inc\r
+// This file contains definitions of DataFlex 3.2 Console Mode macro \r
+// functions that rely on previously defined DataFlex functions.\r
+//\r
+// This file is to be included in df32func.mk\r
+//\r
+// Copyright (c) 2006-2009, glyn@8kb.co.uk\r
+// \r
+// df32func/depmacro.inc\r
+//-------------------------------------------------------------------------\r
+\r
+//-------------------------------------------------------------------------\r
+// Macro commands\r
+//-------------------------------------------------------------------------\r
+\r
+// Create replacement GET_FILE_MOD_TIME - this will replace (leap year) in \r
+// faulty builtin GET_FILE_MOD_TIME command.\r
+// Console mode clients rely on GetTime (win32.inc).\r
+#COMMAND IH_GET_FILE_MOD_TIME R "TO" R\r
+ if (sysconf(sysconf_os_short_name) = 'WIN32CM') begin\r
+ move (get_time(!1,3)) to g_sGetFileModTime\r
+ move (Left(g_sGetFileModTime,10)) to !3\r
+\r
+ #IF (!0 > 3)\r
+ move (mid (g_sGetFileModTime,2,11)) to !4\r
+ #ENDIF\r
+\r
+ #IF (!0 > 4)\r
+ move (mid (g_sGetFileModTime,2,14)) to !5\r
+ #ENDIF\r
+\r
+ #IF (!0 > 5)\r
+ move (mid (g_sGetFileModTime,2,17)) to !6\r
+ #ENDIF\r
+ end // Console mode \r
+ else begin // DOS mode\r
+ !A [] $592 !1 !3\r
+\r
+ #IF (!0 > 3)\r
+ !A [] $593 !4\r
+ #ENDIF\r
+\r
+ #IF (!0 > 4)\r
+ !A [] $594 !5\r
+ #ENDIF\r
+\r
+ #IF (!0 > 5)\r
+ !A [] $595 !6\r
+ #ENDIF\r
+\r
+ // Check& correct year for both modes\r
+ move (check_date_error(!3)) to !3\r
+ end // DOS mode\r
+\r
+#ENDCOMMAND\r
+\r
+// Replace old get_file_mod_time with new\r
+#REPLACE GET_FILE_MOD_TIME IH_GET_FILE_MOD_TIME\r
--- /dev/null
+df32func.inc last compiled on 09/04/2009 at 21:45:13.05 \r
+df32func DLL functions: \r
+tcpcomm.h:external_function ClientSocket "ClientSocket" df32func.dll dword port string host returns integer\r
+tcpcomm.h:external_function ServerSocket "ServerSocket" df32func.dll dword port returns integer\r
+tcpcomm.h:external_function AcceptClient "AcceptClient" df32func.dll returns integer\r
+tcpcomm.h:external_function Send "Send" df32func.dll dword socket string data returns integer\r
+tcpcomm.h:external_function Receive "Receive" df32func.dll dword socket pointer dataOut returns integer\r
+tcpcomm.h:external_function CloseConnection "CloseConnection" df32func.dll dword socket returns integer\r
+tcpcomm.h:external_function PseudoRand "PseudoRand" df32func.dll dword w returns integer\r
+tcpcomm.h:external_function RdtscRand "RdtscRand" df32func.dll returns integer\r
+win32.h:external_function GetDateFormat "GetDateFormatA" kernel32.dll dword LCID dword dwFlags pointer lpsSystemTime pointer lpFormat pointer lpDateStr integer cchDate returns integer\r
+win32.h:external_function GetTimeFormat "GetTimeFormatA" kernel32.dll dword LCID dword dwFlags pointer lpsSystemTime pointer lpFormat pointer lpTimeStr integer cchTime returns integer\r
+win32.h:external_function GetFileTime "GetFileTime" kernel32.dll handle hFileHandle pointer lpCreationTime pointer lpLastAccessTime pointer lpLastWriteTime returns integer\r
+win32.h:external_function FileTimeToSystemTime "FileTimeToSystemTime" kernel32.dll pointer lpFileTime Pointer lpSystemTime returns integer\r
+win32.h:external_function FileTimeToLocalFileTime "FileTimeToLocalFileTime" kernel32.dll pointer lpFileTime Pointer lpSystemTime returns integer\r
+win32.h:external_function FindFirstFile "FindFirstFileA" kernel32.dll pointer lpFileName pointer lpFindFileData returns handle\r
+win32.h:external_function FindNextFile "FindNextFileA" kernel32.dll handle hFindFile pointer lpFindFileData returns integer\r
+win32.h:external_function FindClose "FindClose" kernel32.dll handle hFindFile returns integer\r
+win32.h:external_function LockFile "LockFile" kernel32.dll handle hFile dword dwFileOffsetLow dword dwFileOffsetHigh dword nNumberOfBytesToLockLow dword nNumberOfBytesToLockHigh returns integer\r
+win32.h:external_function UnlockFile "UnlockFile" kernel32.dll handle hFile dword dwFileOffsetLow dword dwFileOffsetHigh dword nNumberOfBytesToLockLow dword nNumberOfBytesToLockHigh returns integer\r
+win32.h:external_function SHFileOperation "SHFileOperationA" shell32.dll pointer lpFileOp returns integer\r
+win32.h:external_function32 GetTempPath "GetTempPathA" kernel32.dll integer nBufferLength pointer lpBuffer_ptr returns integer\r
+win32.h:external_function GetSystemDirectory "GetSystemDirectoryA" kernel32.dll pointer lpBuffer integer uSize returns integer\r
+win32.h:external_function32 mciSendString "mciSendStringA" winmm.dll pointer lpstrCommand pointer lpstrReturnString integer uReturnLength integer hwndCallback returns integer\r
+win32.h:external_function ExitProcessEx "ExitProcess" Kernel32.dll integer iExitCode returns integer\r
+win32.h:external_function GetComputername "GetComputerNameA" kernel32.dll pointer sBuffer pointer lSize returns integer\r
+win32.h:external_function WNetGetUser "WNetGetUserA" MPR.dll pointer lpName pointer lpUserName string lpnLength returns DWord\r
+win32.h:external_function SHBrowseForFolder "SHBrowseForFolder" shell32.dll pointer lpsBrowseInfo returns dword\r
+win32.h:external_function SHGetPathFromIDList "SHGetPathFromIDList" shell32.dll pointer pidList pointer lpBuffer returns dWord\r
+win32.h:external_function CoTaskMemFree "CoTaskMemFree" ole32.dll pointer pV returns integer\r
+win32.h:external_function GetPID "_getpid" msvcrt.dll returns integer\r
+win32.h:external_function getShortPathName "GetShortPathNameA" kernel32.dll pointer lpszLongPath pointer lpszShortPath integer cchBuffer returns integer\r
+win32.h:external_function SetConsoleTitle "SetConsoleTitleA" Kernel32.dll string lpszTitle returns integer\r
+win32.h:external_function FindWindow "FindWindowA" user32.dll pointer lpszClassName string lpszWindowName returns handle\r
+win32.h:external_function GetSystemMenu "GetSystemMenu" user32.dll handle hwnd dword bRevert returns dword\r
+win32.h:external_function EnableMenuItem "EnableMenuItem" user32.dll handle hmenu integer uIDEnableItem integer uEnable returns integer\r
+win32.h:external_function ShellExecute "ShellExecuteA" shell32.dll handle hWnd pointer lpOperation pointer lpFile pointer lpParameters pointer lpDirectory integer nShowCmd returns integer\r
+win32.h:external_function CreateProcess "CreateProcessA" kernel32.dll pointer lpAN pointer lpCL pointer lpPA pointer lpTA integer bIH dword dwCF pointer lpE pointer lpCD pointer lpSI pointer lpPi returns integer\r
+win32.h:external_function OpenProcess "OpenProcess" kernel32.dll dword dwDesiredAccessas integer bInheritHandle dword dwProcId returns handle\r
+win32.h:external_function TerminateProcess "TerminateProcess" kernel32.dll handle hProcess integer uExitCode returns integer\r
+win32.h:external_function CloseHandle "CloseHandle" kernel32.dll handle hObject returns integer\r
+win32.h:external_function WaitForSingleObject "WaitForSingleObject" kernel32.dll handle hHandle dword dwMilliseconds returns integer\r
+win32.h:external_function32 Message_Beep "MessageBeep" user32.dll integer iSound returns integer\r
+win32.h:external_function32 ExitWindowsEx "ExitWindowsEx" user32.dll integer uFlags integer dwReserved returns integer\r
+win32.h:external_function lOpen "_lopen" kernel32.dll string lpPathName integer iReadWrite returns integer\r
+win32.h:external_function lClose "_lclose" kernel32.dll handle hFile returns integer\r
+win32.h:external_function GetLastError "GetLastError" kernel32.dll returns integer\r
+win32.h:external_function CreateFile "CreateFileA" kernel32.dll pointer lpFNname dword dwDAccess dword dwSMode pointer lpSecAttrib dword dwCreationDisp dword dwFlagsAndAttrib handle hTemplateFile returns handle\r
+win32.h:external_function GetFileSize "GetFileSize" kernel32.dll handle hFile pointer lpFileSizeHigh returns integer\r
+win32.h:external_function SetFilePointer "SetFilePointer" kernel32.dll handle hFile dword lDistanceToMove pointer lpDistanceToMoveHigh dword dwMoveMethod returns handle\r
+win32.h:external_function ReadFile "ReadFile" kernel32.dll handle hFile pointer lpBuffer integer nNumberOfBytesToRead pointer lpNumberOfBytesRead pointer lpOverlapped returns integer\r
+win32.h:external_function CopyMemory "RtlMoveMemory" kernel32.dll pointer pDst pointer pSrc integer byteLen returns integer\r
+win32.h:external_function EnumProcesses "EnumProcesses" psapi.dll pointer lpidProcess integer cb pointer cbNeeded returns integer\r
+win32.h:external_function EnumProcessModules "EnumProcessModules" psapi.dll handle hProcess pointer lphModule integer cb integer cbNeeded returns integer\r
+win32.h:external_function WideCharToMultiByte "WideCharToMultiByte" kernel32.dll integer cp dword dwF pointer lpWCS integer cchWC pointer lpMBS integer cchMB string dC string uDC returns integer\r
+win32.h:external_function GetSystemTime "GetSystemTime" kernel32.dll Pointer lpGST returns VOID_TYPE\r
+win32.h:external_function GetTickCount "GetTickCount" kernel32.dll returns dWord\r
+win32.h:external_function32 CoCreateGuid "CoCreateGuid" ole32.dll pointer pGUIDStructure returns word\r
+win32.h:external_function32 StringFromGUID2 "StringFromGUID2" ole32.dll pointer pGUIDStructure pointer lpstrClsId integer cbMax returns dword\r
+win32.h:external_function MsiQueryProductState "MsiQueryProductStateA" msi.dll string szProduct returns integer\r
+win32.h:external_function MilliSleep "Sleep" kernel32.dll integer dwMilliseconds returns integer\r
+win32.h:external_function SetLastError "SetLastError" kernel32.dll dword dwErrCode returns integer\r
+win32.h:external_function FormatMessage "FormatMessageA" kernel32.dll integer dwFlags pointer lpSource dword dwMessageId dword dwLanguageId pointer lpBuffer integer nSize dword Arguments returns integer\r
+win32.h:external_function GetProcessMemoryInfo "GetProcessMemoryInfo" PSAPI.DLL dword l_hProcess pointer ppsmemCounters dword cb returns integer\r
+win32.h:external_function MultiByteToWideChar "MultiByteToWideChar" kernel32.dll integer cp dword dwF pointer lpWCS integer cchWC pointer lpMBS integer cchMB string dC string uDC returns integer\r
+win32.h:external_function GetDiskFreeSpace "GetDiskFreeSpaceA" kernel32.dll string lpRootPathName pointer lpSectorsPC pointer lpBytesPS pointer lpNumberOfFreeClusters pointer lpTotalNOC returns integer\r
+win32.h:external_function InternetCanonicalizeUrl "InternetCanonicalizeUrlA" wininet.dll pointer lpszUrl pointer lpszBuffer pointer lpdwBufferLength dword dwFlags returns integer\r
+win32.h:external_function CryptAcquireContext "CryptAcquireContextA" advapi32.dll pointer phProv string pszContainer string pszProvider dword dwProvType dword dwFlags returns integer\r
+win32.h:external_function CryptReleaseContext "CryptReleaseContext" advapi32.dll pointer phProv dword dwFlags returns integer\r
+win32.h:external_function CryptCreateHash "CryptCreateHash" advapi32.dll handle hProv dword Algid handle hKey dword dwFlags pointer phHash returns integer\r
+win32.h:external_function CryptDestroyHash "CryptDestroyHash" advapi32.dll handle hHash returns integer\r
+win32.h:external_function CryptHashData "CryptHashData" advapi32.dll handle hHash pointer pbData dword dwDataLen dword dwFlags returns integer\r
+win32.h:external_function CryptGetHashParam "CryptGetHashParam" advapi32.dll handle hHash dword dwParam pointer pbData pointer pdwDataLen dword dwFlags returns integer\r
+win32.h:external_function CryptEnumProviders "CryptEnumProvidersA" advapi32.dll dword dwIndex pointer pdwReserved dword dwFlags pointer pdwProvType pointer pcbProvName pointer pszProvName returns integer\r
+win32.h:external_function CryptBinaryToString "CryptBinaryToStringA" crypt32.dll dword pbBinary dword cbBinary dword dwFlags pointer pszString pointer pcchString returns integer\r
+win32.h:external_function CryptGetProvParam "CryptGetProvParam" advapi32.dll handle hProv dword dwParam pointer pbData pointer pdwDataLen dword dwFlags returns integer\r
+win32.h:external_function CryptContextAddRef "CryptGetProvParam" advapi32.dll handle hProv dword pdwReserved dword dwFlags returns integer\r
+win32.h:external_function CryptImportKey "CryptImportKey" advapi32.dll handle hProv pointer pbData pointer pdwDataLen dword hPubKey dword dwFlags pointer phKey returns integer\r
+win32.h:external_function CryptExportKey "CryptExportKey" advapi32.dll handle hKey handle hExpKey dword dwBlobType dword dwFlags pointer pbData pointer pdwDataLen returns integer\r
+win32.h:external_function CryptDeriveKey "CryptDeriveKey" advapi32.dll handle hProv dword Algid handle hHash dword dwFlags pointer phKey returns integer\r
+win32.h:external_function CryptDestroyKey "CryptDestroyKey" advapi32.dll handle hKey returns integer\r
+win32.h:external_function CryptEncrypt "CryptEncrypt" advapi32.dll handle hKey handle hHash dword bFinal dword dwFlags pointer pbData pointer pdwDataLen dword dwBufLen returns integer\r
+win32.h:external_function CryptDecrypt "CryptDecrypt" advapi32.dll handle hKey handle hHash dword bFinal dword dwFlags pointer pbData pointer pdwDataLen returns integer\r
+win32.h:external_function CryptSetKeyParam "CryptSetKeyParam" advapi32.dll handle hKey dword dwParam pointer pbData dword dwFlags returns integer\r
+win32.h:external_function CryptBinaryToString "CryptBinaryToStringA" crypt32.dll dword pbBinary dword cbBinary dword dwFlags pointer pszString pointer pcchString returns integer\r
+win32.h:external_function CryptStringToBinary "CryptStringToBinaryA" crypt32.dll pointer pszString dword cchString dword dwFlags pointer pbBinary pointer pcbBinary pointer pdwSkip pointer pdwFlags returns integer\r
+win32.h:external_function GetVersionEx "GetVersionExA" kernel32.dll pointer lpVersionInfo returns integer\r
+win32.h:external_function GetSystemTime "GetSystemTime" kernel32.dll pointer lpSystemTime returns integer\r
+win32.h:external_function GetTimeZoneInformation "GetTimeZoneInformation" kernel32.dll pointer lpTimeZoneInformation returns integer\r
+win32.h:external_function GetTzi "GetTzi" timezone.dll pointer lpTimeZone pointer lpResult returns integer\r
+df32func functions: \r
+console.inc:function set_mode global integer argv returns integer\r
+console.inc:function screen_display global string argv returns integer\r
+console.inc:function draw_bigchar global string argv integer posx integer posy returns integer\r
+console.inc:function big_text global string argv integer posx integer posy returns integer\r
+date.inc:function get_day_score global date argv returns integer\r
+date.inc:function get_day global date argv returns string\r
+date.inc:function get_month global date argv returns string\r
+date.inc:function get_day_of global date argv returns string\r
+date.inc:function fulldate global date argv returns string\r
+date.inc:function shortdate global date argv returns string\r
+date.inc:function now global string argv returns string\r
+date.inc:function rssdate global date argv string argv2 returns string\r
+date.inc:function cymd global date argv returns string\r
+date.inc:function sqldate global date argv returns string\r
+date.inc:function sqltimestamp global date argv integer argv2 integer argv3 integer argv4 returns string\r
+date.inc:function dftimestamp global date argv integer argv2 integer argv3 integer argv4 returns string\r
+date.inc:function sqldatetime global string argv string argv2 returns string\r
+date.inc:function sqltimestampformat global string argv string argv2 returns string\r
+date.inc:function last_day_of_month global integer month integer year returns date\r
+date.inc:function posixtime global date argv number argv2 number argv3 number argv4 number argv5 returns number\r
+date.inc:function posixtime_reverse global number argv returns string\r
+date.inc:function runtime_timeout global integer argv returns integer\r
+date.inc:function runtime_timeout_reset global returns integer\r
+date.inc:function runtime_timeout_left global returns integer\r
+encode.inc:function is_base64 global integer c returns integer\r
+encode.inc:function int_encode64 global integer uc returns integer\r
+encode.inc:function int_decode64 global integer c returns integer\r
+encode.inc:function encode64 global string sText returns string\r
+encode.inc:function decode64 global string sText returns string\r
+encode.inc:function rc4_array_value integer iIndex returns integer\r
+encode.inc:function rc4 global string key string text returns string\r
+encode.inc:function rc4encode global string key string text returns string\r
+encode.inc:function rc4decode global string key string text returns string\r
+encode.inc:function rc4encode_base64 global string key string text returns string\r
+encode.inc:function rc4decode_base64 global string key string text returns string\r
+hash.inc:function hash_for_df_arrays global string argv returns integer\r
+hash.inc:function reduce_hash global integer argv returns integer\r
+hash.inc:function hash_djb2 global string argv returns integer\r
+hash.inc:function hash_sdbm global string argv returns integer\r
+hash.inc:function hash_lazy global string argv returns integer\r
+math.inc:function decround global number argv integer argv2 returns string\r
+math.inc:function rshift global integer argv integer shift_by returns integer\r
+math.inc:function lshift global integer argv integer shift_by returns integer\r
+math.inc:function ternary global string argv string argv2 string argv3 returns string\r
+string.inc:function titlecase global string argv returns string\r
+string.inc:function replaceall global string argv string argv2 string argv3 returns string\r
+string.inc:function zeropad global string argv integer argv2 returns string\r
+string.inc:function leftpad global string argv integer argv2 returns string\r
+string.inc:function reverse global string argv returns string\r
+string.inc:function addslashes global string argv returns string\r
+string.inc:function quotecsv global string argv returns string\r
+string.inc:function sanitize_int global integer l_iInput integer bound returns integer\r
+string.inc:function sanitize_num global number l_nInput returns integer\r
+string.inc:function sanitize_str global string l_sInput string l_sLevel returns string\r
+string.inc:function nbstring global string argv string argv2 returns string\r
+string.inc:function msxsl global string engine string source string stylesheet string params string outfile returns string\r
+tstamp.inc:function timestemp_to_posix global string inTs returns number\r
+tstamp.inc:function posix_to_timestamp global number argv returns string\r
+tstamp.inc:function timestamp_adjust global string inTs number inMSeconds returns string\r
+tstamp.inc:function interval_to_posix global string argv returns number\r
+tstamp.inc:function timestamp_adjust_interval global string inTs string inInterval returns string\r
+tstamp.inc:function get_day_of_month_for_daylight_savings global integer inYear integer inMonth integer inDayOfWeek integer inDay returns integer\r
+tstamp.inc:function systemtime_utc global returns string\r
+tstamp.inc:function get_bias global string inDestTz integer inYear integer inMon integer inDay integer inHr integer inMin integer inSec integer inIsUTC returns integer\r
+tstamp.inc:function get_utc_time_from_timezone_time global string inDestTz string inTs returns string\r
+tstamp.inc:function get_timezone_time_from_utc_time global string inDestTz string inTs returns string\r
+tstamp.inc:function get_timezone_time_from_timezone_time global string inSourceTz string inDestTz string inTs returns string\r
+win32.inc:function convert_date_format global dword dwLowDateTime dword dwHighDateTime returns string\r
+win32.inc:function list_directory global string argv returns string\r
+win32.inc:function sort_results global integer argv integer argv2 returns integer\r
+win32.inc:function fileopp global string argv string argv2 string argv3 returns integer\r
+win32.inc:function get_local_temp global integer argv returns string\r
+win32.inc:function get_local_system global integer argv returns string\r
+win32.inc:function cd_tray global integer argv returns integer\r
+win32.inc:function exit_process global integer iReturnCode returns integer\r
+win32.inc:function get_process_id global integer argv returns integer\r
+win32.inc:function get_computer global integer argv returns string\r
+win32.inc:function get_user_name global integer argv returns string\r
+win32.inc:function folder_browse global string argv returns String\r
+win32.inc:function get_short_path global string argv returns string\r
+win32.inc:function disable_close global integer argv returns integer\r
+win32.inc:function shell_exec global string argv string argv2 string argv3 returns integer\r
+win32.inc:function create_proc global string argv integer argv2 integer argv3 integer argv4 returns string\r
+win32.inc:function term_proc global string argv integer argv2 returns integer\r
+win32.inc:function is_locked global string argv returns integer\r
+win32.inc:function does_exist global string argv returns integer\r
+win32.inc:function buffer_text_file global string argv string argv2 returns integer\r
+win32.inc:function file_size_bytes global string argv returns integer\r
+win32.inc:function to_ascii global string argv returns string\r
+win32.inc:function to_unicode global string argv returns string\r
+win32.inc:function to_utf8 global string argv returns string\r
+win32.inc:function get_procs global integer argv returns integer\r
+win32.inc:function time_data global integer argv returns string\r
+win32.inc:function fill_0 global integer iValue integer iSize returns string\r
+win32.inc:function check_date_error global string sDate returns date\r
+win32.inc:function get_time global string sFileName integer iMode returns string\r
+win32.inc:function create_guid global returns string \r
+win32.inc:function get_last_error_detail global integer iError returns string\r
+win32.inc:function disk_info global string argv string argv2 returns number\r
+win32.inc:function get_mem_usage global returns integer\r
+win32.inc:function urldecode global string argv returns string\r
+win32.inc:function urlencode global string argv returns string\r
+win32.inc:function get_os_version global returns string\r
+win32.inc:function get_os_version_numeric global returns number\r
+win32.inc:function binary_to_string_to_binary global string argv string argv2 string argv3 returns string\r
+win32.inc:function binary_to_string global string argv string argv2 returns string\r
+win32.inc:function string_to_binary global string argv string argv2 returns string\r
+win32.inc:function ms_adv_listproviders global returns integer\r
+win32.inc:function msAdvCrypt_hash global string in_data string in_hash returns string\r
+win32.inc:function sha512_hex global string in_data returns string\r
+win32.inc:function sha512_base64 global string in_data returns string\r
+win32.inc:function sha384_hex global string in_data returns string\r
+win32.inc:function sha384_base64 global string in_data returns string\r
+win32.inc:function sha256_hex global string in_data returns string\r
+win32.inc:function sha256_base64 global string in_data returns string\r
+win32.inc:function sha1_hex global string in_data returns string\r
+win32.inc:function sha1_base64 global string in_data returns string\r
+win32.inc:function md5_hex global string in_data returns string\r
+win32.inc:function md5_base64 global string in_data returns string\r
+win32.inc:function aes256_hex_enc global string in_data string in_key returns string\r
+win32.inc:function aes256_hex_dec global string in_data string in_key returns string\r
+df32func procedures: \r
+encode.inc:procedure set rc4_array_value integer iIndex integer iVal\r
+encode.inc:procedure create_rc4_key string key\r
+df32func classes: \r
+data.inc:class linkedlist is an array\r
+data.inc:class hashtable is an array\r
+data.inc:class hash is an array\r
+data.inc:class matrix is an array\r
+data.inc:class rss20 is a matrix\r
+data.inc:class filelist is a matrix\r
+data.inc:class UnicodeReader is an array\r
+data.inc:class ListDirectory is a matrix\r
+data.inc:class ProcessList is an array\r
+string.inc:class StringTokenizer is an array\r
+win32.inc:class msAdvCrypt is an array\r
--- /dev/null
+//-------------------------------------------------------------------------\r
+// df32func.mk\r
+// Primary source file for DateFlex 3.2 Console Mode "df32func" extentions\r
+//\r
+// This is the file to be compiled by the dfcomp command\r
+//\r
+// Copyright (c) 2006-2009, glyn@8kb.co.uk\r
+// \r
+// df32func/df32func.mk\r
+//-------------------------------------------------------------------------\r
+//#NOISY 99\r
+//#NOISY 1\r
+\r
+#REM ----------------------------------------------------------------------\r
+#REM Compiling df32func.inc\r
+#REM If precompiling ensure df32func.flp is with your \r
+#REM bytecode and df32func.pki is with your packages\r
+#REM ----------------------------------------------------------------------\r
+\r
+//-------------------------------------------------------------------------\r
+// Set dataflex epoch and set date format to 4 digit years\r
+//-------------------------------------------------------------------------\r
+\r
+set_date_attribute date4_state to dftrue\r
+set_date_attribute epoch_value to 80\r
+set_date_attribute sysdate4_state to dftrue\r
+\r
+//-------------------------------------------------------------------------\r
+// Standard DF32 Console Mode packages \r
+//-------------------------------------------------------------------------\r
+\r
+Use CASE //this package allows the use of switch statements in DataFlex\r
+Use UI //this package contains all the user interface / data classes for OO DataFlex\r
+Use MONARRAY //this package allows the easy monitoring of an array\r
+Use TIMER //this package allows the use of timers to control events\r
+Use DLL //this package allows import of dynamic link libraries, N.B. It contains fake\r
+ //WORD and BYTE types that are incorrect for use in C struct types\r
+//-------------------------------------------------------------------------\r
+// Defines used to control some compile time behaviour\r
+//-------------------------------------------------------------------------\r
+\r
+//Define enable_dfassert\r
+Define no_backslash_quote\r
+Define default_file_channel for 9\r
+\r
+//-------------------------------------------------------------------------\r
+// Global variables used to control some runtime behaviour\r
+//-------------------------------------------------------------------------\r
+\r
+// Turn on any debug lines at runtime\r
+indicator show_debug_lines\r
+\r
+//Used by set msxsl function (string.inc) - set to true to keep msxsl binary in one particular place\r
+indicator g_bMsxslPresent \r
+string g_sMsxslEngine\r
+\r
+//used by runtime (date.inc)\r
+integer g_nRuntime_entry \r
+\r
+//used by replacement GET_FILE_MOD_TIME command (depmacro.inc) \r
+string g_sGetfileModTime\r
+\r
+indicate g_bMsxslPresent false \r
+move "c:\msxsl.exe" to g_sMsxslEngine\r
+move 0 to g_nRuntime_entry\r
+indicate show_debug_lines false\r
+\r
+\r
+//-------------------------------------------------------------------------\r
+// Include main content\r
+//-------------------------------------------------------------------------\r
+\r
+//Including header file win32.h\r
+#INCLUDE win32.h\r
+//Including include file tcpcom.h\r
+#INCLUDE tcpcomm.h\r
+//Including include file console.h\r
+#INCLUDE console.h\r
+//Including include file encode.h\r
+#INCLUDE encode.h\r
+//Including include file errors.h\r
+#INCLUDE errors.h\r
+//Including include file macro.inc\r
+#INCLUDE macro.inc\r
+//Including include file math.inc\r
+#INCLUDE math.inc\r
+//Including include file win32.inc\r
+#INCLUDE win32.inc\r
+//Including include file string.inc\r
+#INCLUDE string.inc\r
+//Including include file date.inc\r
+#INCLUDE date.inc\r
+//Including include file console.inc\r
+#INCLUDE hash.inc\r
+//Including include file data.inc\r
+#INCLUDE data.inc\r
+//Including include file depmacro.inc\r
+#INCLUDE console.inc\r
+//Including include file hash.inc\r
+#INCLUDE depmacro.inc\r
+//Including include file tstamp.inc\r
+#INCLUDE tstamp.inc\r
+//Including include file encode.inc\r
+#INCLUDE encode.inc\r
--- /dev/null
+//-------------------------------------------------------------------------
+// encode.h
+// This file contains soem globale used by RC4 encoding functions
+//
+// This file is to be included when using RC4/Base64 encoding in df32func.mk
+//
+// Copyright (c) 2006-2009, glyn@8kb.co.uk
+//
+// df32func/encode.h
+//-------------------------------------------------------------------------
+
+Define __encode_h__
+
+//-------------------------------------------------------------------------
+// Global variables
+//-------------------------------------------------------------------------
+
+// Used by RC4 functions
+string RC4SBXA 128 RC4SBXB 128 RC4SBXA_TMP 128 RC4SBXB_TMP 128
--- /dev/null
+//-------------------------------------------------------------------------\r
+// encode.inc\r
+// This file contains some DataFlex 3.2 Console Mode functions\r
+// to provide base64 and rc4 encoding/decoding. More advanced \r
+// encoding and encryption can be found in win32.inc.\r
+//\r
+// This file is to be included in df32func.mk\r
+//\r
+// Copyright (c) ????, ????@????.?? (unknown origin)\r
+// \r
+// df32func/encode.inc\r
+//-------------------------------------------------------------------------\r
+\r
+//-------------------------------------------------------------------------\r
+// Functions\r
+//-------------------------------------------------------------------------\r
+\r
+// Check if a string is base64\r
+function is_base64 global integer c returns integer\r
+ if (c >= ascii('A') and c <= ascii('Z')) function_return true\r
+ else if (c >= ascii('a') and c <= ascii('z')) function_return true\r
+ else if (c >= ascii('0') and c <= ascii('9')) function_return true\r
+ else if (c = ascii('+')) function_return true\r
+ else if (c = ascii('/')) function_return true\r
+ else if (c = ascii('=')) function_return true\r
+ else function_return false\r
+end_function\r
+\r
+//encode integer to hex ascii code\r
+function int_encode64 global integer uc returns integer\r
+ if (uc < 26) function_return (ascii('A')+uc)\r
+ else if (uc < 52) function_return (ascii('a')+(uc-26))\r
+ else if (uc < 62) function_return (ascii('0')+(uc-52))\r
+ else if (uc = 62) function_return (ascii('+'))\r
+ else function_return (ascii('/'))\r
+end_function\r
+\r
+//decode hex to integer ascii code\r
+function int_decode64 global integer c returns integer\r
+ if (c >= ascii('A') and c <= ascii('Z')) function_return (c - ascii('A'))\r
+ else if (c >= ascii('a') and c <= ascii('z')) function_return (c - ascii('a') + 26)\r
+ else if (c >= ascii('0') and c <= ascii('9')) function_return (c - ascii('0') + 52)\r
+ else if (c = ascii('+')) function_return 62\r
+ else function_return 63\r
+end_function\r
+\r
+// encode to base64\r
+function encode64 global string sText returns string\r
+ local integer iLen iPos iChar\r
+ local integer by1 by2 by3 \r
+ local integer by4 by5 by6 by7\r
+ local string sRet\r
+ \r
+ move (length(sText)) to iLen\r
+ move 1 to iPos\r
+ \r
+ if iPos Lt 1 function_return \r
+ \r
+ while (iPos <= iLen) \r
+ move 0 to by1\r
+ move 0 to by2\r
+ move 0 to by3 \r
+ move 0 to by4\r
+ move 0 to by5\r
+ move 0 to by6\r
+ move 0 to by7\r
+ \r
+ if (iPos+0 <= iLen) move (ascii(mid(sText,1,iPos+0))) to by1 \r
+ if (iPos+1 <= iLen) move (ascii(mid(sText,1,iPos+1))) to by2\r
+ if (iPos+2 <= iLen) move (ascii(mid(sText,1,iPos+2))) to by3 \r
+ move (rshift(by1,2)) to by4\r
+ move (lshift((by1 iand 3),4) ior rshift(by2,4)) to by5 \r
+ move (lshift((by2 iand 15),2) ior rshift(by3,6)) to by6 \r
+ move (by3 iand 63) to by7\r
+ \r
+ append sRet (character(int_encode64(by4)))\r
+ append sRet (character(int_encode64(by5)))\r
+ \r
+ if (iPos+1<=iLen) append sRet (character(int_encode64(by6)))\r
+ else append sRet "=" \r
+ \r
+ if (iPos+2<=iLen) append sRet (character(int_encode64(by7))) \r
+ else append sRet "="\r
+ \r
+ move (iPos+3) to iPos\r
+ end\r
+ function_return sRet\r
+end_function\r
+\r
+// decode from base64\r
+function decode64 global string sText returns string\r
+ local integer iLen iPos iChar isOK\r
+ local integer c1 c2 c3 c4 \r
+ local integer cc1 cc2 cc3\r
+ local integer by1 by2 by3 by4\r
+ local string sRet\r
+ \r
+ move (length(sText)) to iLen\r
+ \r
+ move 1 to isOK\r
+ for iPos from 1 to iLen\r
+ move (is_base64(ascii(mid(sText,1,iPos)))) to isOK \r
+ if isOK eq 0 Break\r
+ loop\r
+\r
+ if (isOK) begin\r
+ move 1 to iPos\r
+ while (iPos<=iLen)\r
+ move (ascii('A')) to c1\r
+ move (ascii('A')) to c2\r
+ move (ascii('A')) to c3\r
+ move (ascii('A')) to c4\r
+ \r
+ if (iPos+0<=iLen) move (ascii(mid(sText,1,iPos+0))) to c1 \r
+ if (iPos+1<=iLen) move (ascii(mid(sText,1,iPos+1))) to c2\r
+ if (iPos+2<=iLen) move (ascii(mid(sText,1,iPos+2))) to c3\r
+ if (iPos+3<=iLen) move (ascii(mid(sText,1,iPos+3))) to c4\r
+ \r
+ move (int_decode64(c1)) to by1\r
+ move (int_decode64(c2)) to by2\r
+ move (int_decode64(c3)) to by3\r
+ move (int_decode64(c4)) to by4\r
+ \r
+ append sRet (character(lshift(by1,2) ior rshift(by2,4)))\r
+ if (c3<>ascii('=')) append sRet (character(lshift((by2 iand 15),4) ior rshift(by3,2)))\r
+ if (c4<>ascii('=')) append sRet (character(lshift((by3 iand 3) ,6) ior by4))\r
+ \r
+ move (iPos+4) to iPos\r
+ end\r
+ end\r
+ function_return sRet\r
+end_function\r
+\r
+procedure set rc4_array_value integer iIndex integer iVal\r
+ move (iIndex+1) to iIndex\r
+ if iIndex Le 128 ;\r
+ move (Overstrike(character(iVal),rc4SBXA,iIndex)) to rc4SBXA\r
+ else move (Overstrike(character(iVal),rc4SBXB,iIndex-128)) to rc4SBXB\r
+end_procedure\r
+\r
+function rc4_array_value integer iIndex returns integer\r
+ local integer iRet\r
+ move (iIndex+1) to iIndex\r
+ if iIndex Le 128 ;\r
+ move (ascii(mid(rc4SBXA,1,iIndex))) to iRet\r
+ else move (ascii(mid(rc4SBXB,1,iIndex-128))) to iRet\r
+ function_return iRet\r
+end_function\r
+\r
+procedure create_rc4_key string key\r
+ local integer a b keylen idx\r
+ local integer ikey atmp btmp\r
+\r
+ move (length(key)) to keylen\r
+ \r
+ // initialise key array\r
+ move rc4SBXA to rc4SBXA_TMP\r
+ move rc4SBXA to rc4SBXB_TMP\r
+ \r
+ move "" to rc4SBXA\r
+ move "" to rc4SBXB\r
+ \r
+ for idx from 0 to 255\r
+ set rc4_array_value idx to idx\r
+ loop \r
+ \r
+ // encode key array\r
+ for a from 0 to 255\r
+ move (ascii(mid(key,1,mod(a,keylen)+1))) to ikey\r
+ get rc4_array_value a to atmp\r
+ move (mod((b+atmp+ikey),256)) to b\r
+\r
+ get rc4_array_value b to btmp\r
+\r
+ set rc4_array_value a to btmp\r
+ set rc4_array_value b to atmp\r
+ loop\r
+ \r
+end_procedure\r
+\r
+function rc4 global string key string text returns string\r
+ local integer ix iy temp offset origlen cipherlen\r
+ local integer ixtmp iytmp ixytmp ixc\r
+ local string sRet\r
+\r
+ send create_rc4_key key \r
+ move (length(text)) to origlen\r
+ \r
+ move "" to sRet\r
+ for offset from 1 to origlen\r
+ move (mod((offset-1),256)) to ix\r
+ get rc4_array_value ix to ixtmp\r
+ move (mod((iy+ixtmp),256)) to iy\r
+ //\r
+ get rc4_array_value ix to ixtmp\r
+ get rc4_array_value iy to iytmp\r
+ //\r
+ set rc4_array_value ix to iytmp\r
+ set rc4_array_value iy to ixtmp\r
+ //\r
+ move (ascii(mid(text,1,offset))) to ixc\r
+ //\r
+ get rc4_array_value ix to ixtmp\r
+ get rc4_array_value iy to iytmp\r
+ get rc4_array_value (mod((ixtmp+iytmp),256)) to ixytmp\r
+ move ((ixc ior ixytmp) - (ixc iand ixytmp)) to ixc //XOR\r
+ //\r
+ move (sRet+(character(ixc))) to sRet\r
+ loop\r
+ function_return sRet\r
+end_function\r
+\r
+function rc4encode global string key string text returns string\r
+ function_return (rc4(key,text))\r
+end_function\r
+\r
+function rc4decode global string key string text returns string\r
+ function_return (rc4(key,text))\r
+end_function\r
+\r
+function rc4encode_base64 global string key string text returns string\r
+ function_return (encode64(rc4encode(key,text)))\r
+end_function\r
+\r
+function rc4decode_base64 global string key string text returns string\r
+ function_return (rc4decode(key,decode64(text)))\r
+end_function\r
--- /dev/null
+//-------------------------------------------------------------------------
+// errors.h
+// This file contains pre-defined error messages for df32func logic.
+//
+// This file is to be included in df32func.mk
+//
+// Copyright (c) 2006-2009, glyn@8kb.co.uk
+//
+// df32func/errors.h
+//-------------------------------------------------------------------------
+
+//-------------------------------------------------------------------------
+// Error codes
+//-------------------------------------------------------------------------
+enum_list
+ Define ERROR_CODE_DUPLICATE_HASH_KEY$ for 8000
+ Define ERROR_CODE_URLDECODE$
+ Define ERROR_CODE_URLENCODE$
+ Define ERROR_CODE_UNKNOWN_ALGORITHM$
+ Define ERROR_CODE_INCOMPATIBLE_ALGORITHM$
+ Define ERROR_CODE_INVALID_BLOCKSIZE$
+ Define ERROR_CODE_UNRECOGNISED_MODE$
+ Define ERROR_CODE_NO_CONTEXT$
+ Define ERROR_CODE_INVALID_ADDRESS$
+ Define ERROR_CODE_ADDRESS_TAKEN$
+ Define ERROR_CODE_UNKNOWN_FORMAT$
+ Define ERROR_CODE_INVALID_TIMESTAMP$
+ Define ERROR_CODE_INVALID_POSIX_NUMBER$
+ Define ERROR_CODE_INVALID_SYSTEM_TIMEZONE$
+ Define ERROR_CODE_INVALID_BOOLEAN$
+end_enum_list
+
+//-------------------------------------------------------------------------
+// Error messages
+//
+// Maxsize = 40 chars Width guide |----------------------------------------|
+//-------------------------------------------------------------------------
+
+#REPLACE ERROR_MSG_DUPLICATE_HASH_KEY "Duplicate key in unique hashed column"
+#REPLACE ERROR_MSG_URLDECODE "Urldecode failed"
+#REPLACE ERROR_MSG_URLENCODE "Urlencode failed"
+#REPLACE ERROR_MSG_UNKNOWN_ALGORITHM "Unknown crypt algorithm: ??"
+#REPLACE ERROR_MSG_INOMPATIBLE_ALGORITHM "Incompatible algorithm: ??"
+#REPLACE ERROR_MSG_INVALID_BLOCKSIZE "Invalid blocksize: ??"
+#REPLACE ERROR_MSG_UNRECOGNISED_MODE "Unrecognised mode: ??"
+#REPLACE ERROR_MSG_NO_CONTEXT "No crypt context exists"
+#REPLACE ERROR_MSG_INVALID_ADDRESS "Invalid address: ??"
+#REPLACE ERROR_MSG_ADDRESS_TAKEN "Address already taken: ??"
+#REPLACE ERROR_MSG_UNKNOWN_FORMAT "Unknown format: ?? not HEX|BASE64|BIN"
+#REPLACE ERROR_MSG_INVALID_TIMESTAMP "Invalid timestmap"
+#REPLACE ERROR_MSG_INVALID_POSIX_NUMBER "Invalid posix number: ??"
+#REPLACE ERROR_MSG_INVALID_SYSTEM_TIMEZONE "Invalid system timezone"
+#REPLACE ERROR_MSG_INVALID_BOOLEAN "Value does not evaluate to boolean"
+
+//-------------------------------------------------------------------------
+// Error message detail
+//
+// Maxsize = 32 chars Width guide |--------------------------------|
+//-------------------------------------------------------------------------
+#REPLACE ERROR_DETAIL_DUPLICATE_HASH_KEY "Duplicate key at index: ??"
+#REPLACE ERROR_DETAIL_GETLASTERROR "GetLastError = ??"
+#REPLACE ERROR_DETAIL_INVALID_TIMESTAMP "Format: ??"
+#REPLACE ERROR_DETAIL_INVALID_BOOLEAN "Value ?? != true/false"
--- /dev/null
+//-------------------------------------------------------------------------\r
+// hash.inc\r
+// This file contains some DataFlex 3.2 Console Mode functions\r
+// to provide limited hashing algorithms. More advanced hashing\r
+// can be found in win32.inc.\r
+//\r
+// This file is to be included in df32func.mk\r
+//\r
+// Copyright (c) 2006-2009, glyn@8kb.co.uk\r
+// \r
+// df32func/hash.inc\r
+//-------------------------------------------------------------------------\r
+\r
+//-------------------------------------------------------------------------\r
+// Functions\r
+//-------------------------------------------------------------------------\r
+\r
+// Produces an integer hash value for indexing into a DataFlex array.\r
+//\r
+// This is a rather unaccomplished hash, but is specifically designed to produce\r
+// positive hashed values with a relatively low integer range (< 10,000,000)\r
+// in order to give a decent distribution and still fit into a DataFlex 3.2 \r
+// array object.\r
+// It can without doubt be improved.\r
+//\r
+// Note that whilst this hash may appear to preserve ascii order to some \r
+// degree this is an artifact rather than by design and cannot be relied on.\r
+function hash_for_df_arrays global string argv returns integer\r
+ local integer l_iHash\r
+ local string l_sTmp\r
+ \r
+ move 0 to l_iHash\r
+ move (lowercase(trim(argv))) to l_sTmp\r
+ \r
+ if (l_sTmp <> "") begin\r
+ // Start at the first character of the string and produce distributed starting points for integer hash values\r
+ if (mid(l_sTmp,1,1)) in "1234567890" move (((ascii(mid(l_sTmp,1,1)))-47)*200000) to l_iHash //index at 1-10\r
+ if (mid(l_sTmp,1,1)) in "abcdefghijklmnopqrstuvwxyz" move (((ascii(mid(l_sTmp,1,1)))-86)*200000) to l_iHash //index at 11-36 \r
+ if not (mid(l_sTmp,1,1)) in "1234567890abcdefghijklmnopqrstuvwxyz" move (37*200000) to l_iHash //index at 37+\r
+\r
+ // Take the sum of the second, last and middle chars (upper and lowercase) in the string and add to the hash\r
+ if (length(argv) > 1) calc (l_iHash + (ascii(mid(argv,1,2)))) to l_iHash\r
+ if (length(argv) > 2) calc (l_iHash + (ascii(mid(argv,1,(length(argv)))))) to l_iHash\r
+ if (length(argv) > 4) calc (l_iHash + (ascii(mid(argv,1,(length(argv)/2))))) to l_iHash\r
+\r
+ // If the string is longer than 9 chars add the second last val * 100 to the hash\r
+ if (length(argv) > 9) calc (l_iHash + (100*(ascii(mid(argv,1,(length(argv)-2)))))) to l_iHash\r
+\r
+ // Add the length of the string onto the hash if shorter than 255 chars, else add 256.\r
+ if (length(argv) > 255) calc (l_iHash + 256) to l_iHash\r
+ else calc (l_iHash + length(argv)) to l_iHash\r
+ end\r
+ else begin\r
+ move 0 to l_iHash\r
+ end\r
+ \r
+ function_return l_iHash\r
+end_function\r
+\r
+// Chop up an integer hash that is out of the optimal DataFlex 3.2 array\r
+// size range and make it fit. This reduces the uniqueness of the hash but\r
+// unfortuantely is a necessary evil when using out of range hashes.\r
+function reduce_hash global integer argv returns integer\r
+ local integer l_iHash\r
+ \r
+ // Make sure positive\r
+ if (argv < 0) calc (argv*-1) to l_iHash\r
+ else move argv to l_iHash\r
+ \r
+ // Unashamedly chop out the middle range\r
+ if (length(string(l_iHash)) > 7) begin\r
+ move (integer(left(string(l_iHash),3)+right(string(l_iHash), 3))) to l_iHash\r
+ end\r
+ \r
+ function_return l_iHash\r
+end_function\r
+\r
+// Djb2 hashing from Dan Bernstein\r
+//\r
+// The main info is here http://fr.wikipedia.org/wiki/Table_de_hachage#Fonction_de_Hachage\r
+//\r
+// http://en.wikipedia.org/wiki/Daniel_J._Bernstein\r
+// http://cr.yp.to/djb.html\r
+// http://www.cse.yorku.ca/~oz/hash.html\r
+function hash_djb2 global string argv returns integer\r
+ local integer l_iHash l_i\r
+ \r
+ move 5381 to l_iHash\r
+ \r
+ for l_i from 1 to (length(argv))\r
+ move ((LShift(l_iHash,5) + l_iHash) + (ascii(mid(argv,1,L_i)))) to l_iHash\r
+ loop\r
+ \r
+ function_return l_iHash\r
+end_function\r
+\r
+// This is the SDBM hashing algorithm as used in berkeley DB\r
+//\r
+// http://cpansearch.perl.org/src/RGARCIA/perl-5.10.0/ext/SDBM_File/sdbm/README\r
+// http://en.wikipedia.org/wiki/Dbm\r
+// http://en.wikipedia.org/wiki/Sleepycat_Software\r
+// http://en.wikipedia.org/wiki/Berkeley_DB\r
+function hash_sdbm global string argv returns integer\r
+ local integer l_iHash l_i\r
+ \r
+ move 0 to l_iHash\r
+ \r
+ for l_i from 1 to (length(argv))\r
+ move ((ascii(mid(argv,1,L_i))) + (LShift(l_iHash,6)) + (LShift(l_iHash,16)) - l_iHash) to l_iHash\r
+ loop\r
+ \r
+ function_return l_iHash\r
+end_function\r
+\r
+// Lazy hash, efficient for small fairly unique strings.\r
+function hash_lazy global string argv returns integer\r
+ local integer l_iHash l_i\r
+ \r
+ move 0 to l_iHash\r
+ \r
+ for l_i from 1 to (length(argv))\r
+ move (l_iHash + (ascii(mid(argv,1,L_i)))) to l_iHash\r
+ loop\r
+ \r
+ function_return l_iHash\r
+end_function\r
--- /dev/null
+//-------------------------------------------------------------------------
+// macro.inc
+// This file contains definitions of DataFlex 3.2 Console Mode macro functions
+// to provide some extended command functionality.
+//
+// This file is to be included in df32func.mk
+//
+// Copyright (c) 2006-2009, glyn@8kb.co.uk
+//
+// df32func/macro.inc
+//-------------------------------------------------------------------------
+
+//-------------------------------------------------------------------------
+// Macro commands
+//-------------------------------------------------------------------------
+
+
+// Assertions
+// ASSERT <true/false evaluation> <assert message> -- provides a similar functionality to c assert.
+//
+// if enable_dfassert is defined then evaluations are run and errors are raised
+// if enable_dfassert is undefined then assertions are effectively removed at compile time
+//
+// A failed assertion will raise an error
+//
+// Example usage:
+//
+// Define enable_dfassert
+// ASSERT (1=2) "TEST ASSERT"
+//
+#COMMAND ASSERT R
+ #IFDEF enable_dfassert
+ #IF (!0=2)
+ #IFTYPE !1 "I"
+ if (!1 = 0);
+ error 999999 ("RAISED ASSERTION: '"+string(!2)+"'")
+ #ENDIF
+ #ENDIF
+ #ENDIF
+#ENDCOMMAND
+
+// Custom errors
+//
+// Used to produce multiline error messages as the error command is
+// limited to 40 chars (the original length of ERROR_DESCR in FLEXERRS.DAT)
+//
+// Will replace "??" in any message with a variable
+//
+// Example usage:
+//
+// custom_error <error_code> <error_message>
+// custom_error <error_code> <error_message> <error_message replacement>
+// custom_error <error_code> <error_message> <error_detail> <error_detail replacement>
+//
+#COMMAND CUSTOM_ERROR R
+ #IF (!0>1)
+ #IFTYPE !1 "I"
+ #IFTYPE !2 "S"
+ #IF (!0=2)
+ error !1 !2
+ #ELSE
+ #IF (!0=3)
+ error !1 (replace("??", !2, string(!3)))
+ #ELSE
+ #IF (!0=4)
+ error !1 !2
+ #IFTYPE !3 "S"
+ error !1 ("Detail: "+(replace("??", !3, string(!4))))
+ #ENDIF
+ #ENDIF
+ #ENDIF
+ #ENDIF
+ #ENDIF
+ #ENDIF
+ #ENDIF
+#ENDCOMMAND
+
+// Ternary command (an operator would be nice)
+// Behaves similar to perl/c ternary operators E.g. "(evaluation) ? true_var : false_var"
+//
+// Example usage:
+//
+// ternary mytable.myboolean "YES" "NO" my_string
+// ternary (1=1) "YES" "NO" my_string
+//
+// Note that this command form functions just like perl/c and if something like:
+// "(evaluation) ? true_evaluation : false_evaluation" is written then only the
+// secondary OR tertiary evaluation will execute dependant on the result of
+// the primary evaluation.
+//
+// There is also a "ternary" function (math.inc) which can be used in place of an operator,
+// however beware that the function works differently; both the secondary AND tertiary
+// evaluations happen before primary evaluation is tested, rather than being exclusive
+// (as they should really be) this is a limitation of passing via the function. Thus
+// the function is only really useful for variables.
+//
+#COMMAND TERNARY R
+ #IF (!0>3)
+ #IFTYPE !1 "I"
+ if (!1 = 1) move !2 to !4
+ else move !3 to !4
+ #ELSE
+ #IFTYPE !1 "S"
+ if ((lowercase(!1) eq 't') or (lowercase(!1) eq 'true')) move !2 to !4
+ else move !3 to !4
+ #ELSE
+ move !3 to !4
+ #ENDIF
+ #ENDIF
+ #ENDIF
+#ENDCOMMAND
--- /dev/null
+//-------------------------------------------------------------------------\r
+// math.inc\r
+// This file contains some DataFlex 3.2 Console Mode functions\r
+// to provide extended mathematical capabilities.\r
+//\r
+// This file is to be included in df32func.mk\r
+//\r
+// Copyright (c) 2006-2009, glyn@8kb.co.uk\r
+// \r
+// df32func/math.inc\r
+//-------------------------------------------------------------------------\r
+\r
+//-------------------------------------------------------------------------\r
+// Functions\r
+//-------------------------------------------------------------------------\r
+\r
+// Round a number to n decimal places. Returns a string.\r
+// argv = number argv2 = decimal places\r
+function decround global number argv integer argv2 returns string\r
+ local number l_nInVal l_nDcnVal l_nDcnDecVal l_nDcnAppPoints\r
+ local integer l_iDcnPoints\r
+ local string l_sReturn\r
+\r
+ move argv to l_nInVal\r
+ move argv2 to l_iDcnPoints\r
+ \r
+ move (number("0."+repeat(0,l_iDcnPoints)+"5")) to l_nDcnDecVal\r
+ if (l_nInVal < 0) calc (l_nDcnDecVal*-1) to l_nDcnDecVal\r
+ calc (l_nInVal+l_nDcnDecVal) to l_nDcnVal \r
+\r
+ move (l_iDcnPoints-(length(l_nDcnVal)-pos(".", l_nDcnVal))) to l_nDcnAppPoints\r
+ if (l_iDcnPoints >= 1) move (left(l_nDcnVal,((pos(".",l_nDcnVal))+l_iDcnPoints))) to l_sReturn\r
+ else move (left(l_nDcnVal,((pos(".",l_nDcnVal))+l_iDcnPoints)-1)) to l_sReturn\r
+ if (not (l_sReturn contains ".") and l_iDcnPoints <> 0) append l_sReturn "." (repeat("0",l_iDcnPoints))\r
+ else if (l_nDcnAppPoints > 0) append l_sReturn (repeat("0",l_nDcnAppPoints))\r
+ if (number(l_sReturn) = 0) move (replaces("-",l_sReturn,"")) to l_sReturn\r
+\r
+ function_return l_sReturn\r
+\r
+end_function\r
+\r
+// Performs a right binary shift on a variable.\r
+// Relies on the embedded binary arithmetic of ior and iand\r
+function rshift global integer argv integer shift_by returns integer\r
+ function_return (integer(argv/(2^shift_by)) iand 255)\r
+end_function\r
+\r
+// Performs a left binary shift on a variable.\r
+// Relies on the embedded binary arithmetic of ior and iand\r
+function lshift global integer argv integer shift_by returns integer\r
+ function_return (integer(argv*(2^shift_by)) iand 255) \r
+end_function\r
+\r
+// Ternary operator function like perls boolean ? "true var" : "false var"\r
+// Relies on TERNARY command (macro.inc) - beware all evaluations passed to \r
+// the function are actually run, so only usefull for strings really in argv2/3\r
+function ternary global string argv string argv2 string argv3 returns string\r
+ local string l_sReturn\r
+ local integer tmp\r
+\r
+ if ((argv = "0") or (argv = "1")) begin\r
+ ternary (integer(argv)) argv2 argv3 l_sReturn\r
+\r
+ end\r
+ else if ("@t@f@false@true@" contains ("@"+lowercase(argv)+"@")) begin\r
+ ternary argv argv2 argv3 l_sReturn\r
+ end\r
+ else begin\r
+ custom_error ERROR_CODE_INVALID_BOOLEAN$ ERROR_MSG_INVALID_BOOLEAN ERROR_DETAIL_INVALID_BOOLEAN argv\r
+ end\r
+ function_return l_sReturn\r
+end_function\r
--- /dev/null
+//-------------------------------------------------------------------------\r
+// string.inc\r
+// This file contains some DataFlex 3.2 Console Mode functions\r
+// and classes to provide extended string manipulation capabilities.\r
+//\r
+// This file is to be included in df32func.mk\r
+//\r
+// Copyright (c) 2006-2009, glyn@8kb.co.uk\r
+// \r
+// df32func/string.inc\r
+//-------------------------------------------------------------------------\r
+\r
+//-------------------------------------------------------------------------\r
+// Functions\r
+//-------------------------------------------------------------------------\r
+\r
+// Convert a string to titlecase\r
+function titlecase global string argv returns string\r
+ local string l_01tmpStr\r
+ local integer l_01tmpInt\r
+\r
+ move "" to l_01tmpStr\r
+ lp_maketitle01:\r
+ append l_01tmpStr (uppercase(left(argv,1)))\r
+ pos " " in argv to l_01tmpInt\r
+ if l_01tmpInt eq 0 begin\r
+ length (trim(argv)) to l_01tmpInt\r
+ append l_01tmpStr (lowercase(right(argv,(l_01tmpInt-1))))\r
+ goto lp_exittitle01\r
+ end\r
+ append l_01tmpStr (lowercase(mid(argv,(l_01tmpInt-1),2))) \r
+ trim (mid(argv,(length(argv)),(l_01tmpInt+1))) to argv \r
+ goto lp_maketitle01\r
+ lp_exittitle01:\r
+\r
+ function_return l_01tmpStr\r
+end_function\r
+\r
+//replace all characters in argv2 found in argv with srting in argv3 - see replaces\r
+function replaceall global string argv string argv2 string argv3 returns string\r
+ local integer l_01tmpInt\r
+ \r
+ move (trim(argv)) to argv\r
+ for l_01tmpInt from 1 to (length(argv))\r
+ move (replaces((mid(argv,1,l_01tmpInt)),argv2,argv3)) to argv2\r
+ loop\r
+ \r
+ function_return argv2\r
+end_function\r
+\r
+// Pad a string with zeros to the left\r
+function zeropad global string argv integer argv2 returns string\r
+ local string l_01tmpStr\r
+ \r
+ move "" to l_01tmpStr\r
+ move (repeat("0",(argv2-(length(trim(argv)))))) to l_01tmpStr\r
+ append l_01tmpStr (trim(argv))\r
+ \r
+ function_return l_01tmpStr\r
+end_function\r
+\r
+// Padd a string with spaces to the left\r
+function leftpad global string argv integer argv2 returns string\r
+ local string l_01tmpStr\r
+ \r
+ move "" to l_01tmpStr\r
+ move (repeat(" ",(argv2-(length(trim(argv)))))) to l_01tmpStr\r
+ append l_01tmpStr (trim(argv))\r
+ \r
+ function_return l_01tmpStr\r
+end_function\r
+\r
+// Returns the string in reverse\r
+function reverse global string argv returns string\r
+ local string l_sReturn\r
+ local integer l_i l_iLen\r
+ \r
+ move (length(argv)) to l_iLen\r
+ move "" to l_sReturn\r
+ \r
+ for l_i from 0 to l_iLen\r
+ append l_sReturn (mid(argv,1,l_iLen-l_i))\r
+ loop\r
+ \r
+ function_return l_sReturn\r
+end_function\r
+\r
+// Standard escaping via C standard.\r
+//\r
+// For PostgreSQL when no_backslash_quote is defined single quotes are \r
+// escaped per SQL standard by doubling '' rather than \' because in \r
+// some encodings multibyte characters have a last byte numerically \r
+// equivalent to ASCII escaped by backslash "\".\r
+// This should not be required if client encoding is LATIN1\r
+// and safe_encoding is set.\r
+function addslashes global string argv returns string\r
+ local string l_sReturn\r
+ \r
+ move (replaces("\",argv,"\\")) to l_sReturn\r
+ #IFDEF no_backslash_quote\r
+ move (replaces("'",l_sReturn,"''")) to l_sReturn\r
+ #ELSE\r
+ move (replaces("'",l_sReturn,"\'")) to l_sReturn\r
+ #ENDIF\r
+ move (replaces('"',l_sReturn,'\"')) to l_sReturn\r
+ \r
+ function_return l_sReturn\r
+end_function\r
+\r
+// Standard escaping for quoted CSV standard\r
+function quotecsv global string argv returns string\r
+ local string l_sReturn\r
+ \r
+ move (replaces('"',argv,'""')) to l_sReturn\r
+ \r
+ function_return l_sReturn\r
+end_function\r
+\r
+// Sanitize an integer for use in an sql statement. \r
+// This doesn't do anything other than make sure the value fits in the integer\r
+function sanitize_int global integer l_iInput integer bound returns integer\r
+ local integer l_iReturn\r
+ \r
+ move (integer(l_iInput)) to l_iReturn\r
+ \r
+ function_return l_iReturn \r
+end_function\r
+\r
+// Sanitize an number for use in an sql statement. \r
+// This doesn't do anything other than make sure the value fits in the number\r
+function sanitize_num global number l_nInput returns integer\r
+ local number l_nReturn\r
+ \r
+ move (number(l_nInput)) to l_nReturn\r
+ \r
+ function_return l_nReturn \r
+end_function\r
+\r
+// Sanitize a string. 3 Modes\r
+// SQL - this just does addslashes \r
+// SYSTEM - removes all characters that could be problematic at the console\r
+// PARANOID - removes all non alphanumeric characters and any aparent sql it is worried about.\r
+function sanitize_str global string l_sInput string l_sLevel returns string\r
+ local string l_sReturn\r
+ local integer l_i l_iCode l_iBadScore\r
+ \r
+ move (uppercase(trim(l_sLevel))) to l_sLevel\r
+ if ((l_sLevel <> "SQL") and (l_sLevel <> "SYSTEM") and (l_sLevel <> "PARANOID")) move "PARANOID" to l_sLevel\r
+ move "" to l_sReturn\r
+ \r
+ if (length(l_sInput) <> 0) begin\r
+ if (l_sLevel = "SQL") move (addslashes(l_sInput)) to l_sReturn\r
+ \r
+ if (l_sLevel = "SYSTEM") begin\r
+ move (replaceall("!=()<>/\|`'^~%$#;&",l_sInput,"")) to l_sReturn\r
+ move (replaces(character(10),l_sReturn,"")) to l_sReturn\r
+ move (replaces(character(13),l_sReturn,"")) to l_sReturn\r
+ move (replaces('"',l_sReturn,'')) to l_sReturn\r
+ end\r
+ if (l_sLevel = "PARANOID") begin\r
+ for l_i from 1 to (length(l_sInput))\r
+ move (ascii(mid(l_sInput,1,l_i))) to l_iCode\r
+ if (((l_iCode >= 48) and (l_iCode <= 57)) or ((l_iCode >= 65) and (l_iCode <=90)) or ((l_iCode >= 97) and (l_iCode <=122)) or (l_iCode = 32)) begin\r
+ append l_sReturn (mid(l_sInput,1,l_i))\r
+ end\r
+ loop\r
+ \r
+ move 0 to l_iBadScore\r
+ if ((uppercase(l_sReturn) contains "DROP ") or (uppercase(l_sReturn) contains "CREATE ") or (uppercase(l_sReturn) contains "ALTER ") or (uppercase(l_sReturn) contains "TRUNCATE ") or (uppercase(l_sReturn) contains "COPY ")) begin\r
+ increment l_iBadScore\r
+ if (uppercase(l_sReturn) contains " TABLE ") increment l_iBadScore\r
+ if (uppercase(l_sReturn) contains " INDEX ") increment l_iBadScore\r
+ if (uppercase(l_sReturn) contains " DATABASE ") increment l_iBadScore\r
+ if (uppercase(l_sReturn) contains " GROUP ") increment l_iBadScore\r
+ if (uppercase(l_sReturn) contains " FUNCTION ") increment l_iBadScore\r
+ if (uppercase(l_sReturn) contains " RULE ") increment l_iBadScore\r
+ if (uppercase(l_sReturn) contains " AGGREGATE ") increment l_iBadScore\r
+ if (uppercase(l_sReturn) contains " TYPE ") increment l_iBadScore\r
+ if (uppercase(l_sReturn) contains " TRIGGER ") increment l_iBadScore\r
+ if (uppercase(l_sReturn) contains " OPERATOR ") increment l_iBadScore\r
+ if (uppercase(l_sReturn) contains " USER ") increment l_iBadScore\r
+ if (uppercase(l_sReturn) contains " SEQUENCE ") increment l_iBadScore\r
+ end\r
+ else if ((uppercase(l_sReturn) contains "GRANT ") or (uppercase(l_sReturn) contains "REVOKE ")) begin\r
+ increment l_iBadScore\r
+ if ((uppercase(l_sReturn) contains " ON ") and (uppercase(l_sReturn) contains " TO ")) increment l_iBadScore\r
+ if ((uppercase(l_sReturn) contains " ON ") and (uppercase(l_sReturn) contains " FROM ")) increment l_iBadScore\r
+ if (uppercase(l_sReturn) contains " ALL ") increment l_iBadScore\r
+ if (uppercase(l_sReturn) contains " ALL ") increment l_iBadScore\r
+ \r
+ end\r
+ else if ((uppercase(l_sReturn) contains "UPDATE ") or (uppercase(l_sReturn) contains "DELETE ")) begin\r
+ increment l_iBadScore\r
+ if (not (uppercase(l_sReturn)) contains " WHERE") increment l_iBadScore\r
+ end\r
+ if (l_iBadScore > 1) begin\r
+ move "" to l_sReturn\r
+ end\r
+ end\r
+ \r
+ end\r
+ else begin\r
+ move l_sInput to l_sReturn\r
+ end\r
+ \r
+ function_return l_sReturn \r
+end_function\r
+\r
+// Return none blank of two strings\r
+function nbstring global string argv string argv2 returns string\r
+ if (argv <> "") function_return argv\r
+ else if (argv2 <> "") function_return argv2\r
+ else function_return ""\r
+end_function\r
+\r
+// Do transformation of xml based on xsl stylesheet\r
+// E.g. msxsl("\\somehost\bin\msxsl.exe", "c:\test.xml","c:\test.xsl","","c:\test.html")\r
+function msxsl global string engine string source string stylesheet string params string outfile returns string\r
+ local string l_sRemoteEngine l_sFile l_sOpts l_sReturn\r
+ local string l_iThrow l_iFileSize\r
+ \r
+ move (trim(engine)) to engine\r
+ move (trim(source)) to source\r
+ move (trim(stylesheet)) to stylesheet\r
+ move (trim(params)) to params\r
+ move (trim(outfile)) to outfile\r
+ move "" to l_sReturn \r
+ \r
+ // Attempt to keep a copy of the executable locally regardless of location\r
+ if not (g_bMsxslPresent) begin\r
+ if (does_exist(engine) = 1) begin\r
+ if (does_exist(g_sMsxslEngine) = 0) begin\r
+ move (fileopp("copy",engine,g_sMsxslEngine)) to l_iThrow\r
+ if (l_iThrow <> 0) move engine to g_sMsxslEngine\r
+ end\r
+ indicate g_bMsxslPresent true\r
+ end\r
+ else indicate g_bMsxslPresent false\r
+ end\r
+ \r
+ if (g_bMsxslPresent) begin\r
+ if (outfile = "") move (trim(cstring(get_local_temp(0)))+"msxsl."+(create_guid())) to l_sFile\r
+ else move outfile to l_sFile\r
+ \r
+ if ((source <> "") and (does_exist(source) = 1) and (stylesheet <> "") and (does_exist(stylesheet) = 1)) begin\r
+ move (source+" "+stylesheet+" -o "+l_sFile) to l_sOpts\r
+ if (params <> "") append l_sOpts " " params\r
+ move (create_proc(g_sMsxslEngine+" "+l_sOpts,0,0,0)) to l_iThrow\r
+\r
+ if (outfile = "") begin\r
+ move (file_size_bytes(l_sFile)) to l_iFileSize\r
+ direct_input channel default_file_channel l_sFile\r
+ read_block channel default_file_channel l_sReturn l_iFileSize\r
+ close_input channel default_file_channel\r
+ move (fileopp("delete",l_sFile,"")) to l_iThrow\r
+ end\r
+ else move outfile to l_sReturn\r
+ end\r
+ end\r
+ \r
+ function_return l_sReturn\r
+end_function\r
+\r
+//-------------------------------------------------------------------------\r
+// Classes\r
+//-------------------------------------------------------------------------\r
+\r
+// String tokenizer class\r
+//\r
+// Send message methods:\r
+// set_string\r
+//\r
+// Set methods:\r
+// token_value \r
+//\r
+// Get methods:\r
+// token_value \r
+// token_count\r
+// next_token\r
+// token_ptr\r
+//\r
+// Example usage:\r
+//\r
+// object myToken is a StringTokenizer\r
+// end_object\r
+//\r
+// send set_string to (myToken(current_object)) tmp ","\r
+//\r
+// get token_count of (myToken(current_object)) to x\r
+//\r
+// for i from 0 to x\r
+// get token_value of (myToken(current_object)) item i to buf\r
+// showln buf\r
+// loop\r
+//\r
+// repeat\r
+// get next_token of (myToken(current_object)) to buf\r
+// showln buf\r
+// get token_ptr of (myToken(current_object)) to i\r
+// until (i = -1)\r
+\r
+class StringTokenizer is an array\r
+ procedure construct_object integer argc\r
+ forward send construct_object\r
+ property integer c_iTokens public argc\r
+ property integer c_iTokenOn\r
+ end_procedure\r
+\r
+ procedure set_string string inString string inSep\r
+ local integer l_iTokens l_iPos l_iPad\r
+ local string l_01tmpStr l_02tmpStr\r
+\r
+ move -1 to l_iTokens\r
+ move (trim(inString)) to l_01tmpStr\r
+ move (length(inSep)) to l_iPad\r
+ move 2 to l_iPos\r
+ \r
+ while (l_01tmpStr <> "") \r
+ if (inSep <> "") move (pos(inSep,l_01tmpStr)) to l_iPos\r
+ \r
+ move (left(l_01tmpStr, (l_iPos-1))) to l_02tmpStr\r
+ if (l_01tmpStr = l_02tmpStr) move "" to l_01tmpStr\r
+ else move (right(l_01tmpStr,length(l_01tmpStr)-(l_iPos+l_iPad-1))) to l_01tmpStr\r
+\r
+ increment l_iTokens\r
+ forward set array_value item l_iTokens to l_02tmpStr\r
+ end \r
+ \r
+ set c_iTokenOn to 0\r
+ set c_iTokens to l_iTokens\r
+ end_procedure\r
+\r
+ procedure set token_value integer itemx string val\r
+ forward set array_value item itemx to val\r
+ end_procedure\r
+\r
+ function token_value integer itemx returns string\r
+ local string l_sBuf \r
+ forward get string_value item itemx to l_sBuf\r
+ function_return l_sBuf\r
+ end_function \r
+\r
+ function next_token returns string\r
+ local string l_sBuf\r
+ local string l_iTokenOn l_iTokens\r
+ \r
+ get c_iTokenOn to l_iTokenOn \r
+ get c_iTokens to l_iTokens\r
+ forward get string_value item l_iTokenOn to l_sBuf\r
+ \r
+ if (l_iTokenOn < l_iTokens) set c_iTokenOn to (l_iTokenOn+1)\r
+ else set c_iTokenOn to -1\r
+ function_return l_sBuf\r
+ end_function \r
+\r
+ function token_ptr returns integer\r
+ local integer l_iTokenOn\r
+ get c_iTokenOn to l_iTokenOn\r
+ function_return l_iTokenOn\r
+ end_function\r
+ \r
+ function token_count returns integer\r
+ local integer l_iTokens\r
+ get c_iTokens to l_iTokens\r
+ function_return l_iTokens\r
+ end_function\r
+end_class\r
--- /dev/null
+//-------------------------------------------------------------------------\r
+// tcpcomm.h\r
+// This file contains definitions of "Win32" api functions provided by\r
+// the df32func.dll dynamic link library.\r
+//\r
+// This file is to be included when using socket networking in df32func.mk\r
+//\r
+// Copyright (c) 2006-2009, glyn@8kb.co.uk\r
+//\r
+// df32func/tcpcomm.h\r
+//-------------------------------------------------------------------------\r
+\r
+Define __tcpcomm_h__\r
+\r
+//-------------------------------------------------------------------------\r
+// External functions\r
+//-------------------------------------------------------------------------\r
+\r
+external_function ClientSocket "ClientSocket" df32func.dll dword port string host returns integer\r
+external_function ServerSocket "ServerSocket" df32func.dll dword port returns integer\r
+external_function AcceptClient "AcceptClient" df32func.dll returns integer\r
+external_function Send "Send" df32func.dll dword socket string data returns integer\r
+external_function Receive "Receive" df32func.dll dword socket pointer dataOut returns integer\r
+external_function CloseConnection "CloseConnection" df32func.dll dword socket returns integer\r
+external_function PseudoRand "PseudoRand" df32func.dll dword w returns integer\r
+external_function RdtscRand "RdtscRand" df32func.dll returns integer\r
--- /dev/null
+//-------------------------------------------------------------------------\r
+// tstamp.inc\r
+// This file contains some DataFlex 3.2 Console Mode functions\r
+// to provide extended timestamp and timezone manipulation capabilities.\r
+// Depends on functions in both win32.inc and string.inc/\r
+//\r
+// This file is to be included in df32func.mk\r
+//\r
+// Copyright (c) 2006-2009, glyn@8kb.co.uk\r
+// \r
+// df32func/tstamp.inc\r
+//-------------------------------------------------------------------------\r
+\r
+//-------------------------------------------------------------------------\r
+// Global tokenizer used for splitting timezon data\r
+//-------------------------------------------------------------------------\r
+object tzTok is a StringTokenizer\r
+end_object\r
+\r
+//-------------------------------------------------------------------------\r
+// Functions\r
+//-------------------------------------------------------------------------\r
+\r
+// Convert a textual timestamp to a posix number\r
+// Also see posixtime and posixtime_reverse in date.inc\r
+function timestemp_to_posix global string inTs returns number\r
+ local number l_posix l_hr l_min l_sec l_msec\r
+ local date l_date\r
+\r
+ // leap seconds not coded \r
+ if ((length(inTs) < 10) or (mid(inTs, 1, 3) <> "/") or (mid(inTs, 1, 6) <> "/") or (mid(inTs, 1, 11) <> " ")) begin\r
+ custom_error ERROR_CODE_INVALID_TIMESTAMP$ ERROR_MSG_INVALID_TIMESTAMP ERROR_DETAIL_INVALID_TIMESTAMP "DD/MM/YYYY"\r
+ end\r
+ if (((length(inTs) >= 16) and (mid(inTs, 1, 14) <> ":")) or ((length(inTs) >= 19) and (mid(inTs, 1, 17) <> ":"));\r
+ or ((length(inTs) >= 21) and (mid(inTs, 1, 20) <> "."))) begin\r
+ custom_error ERROR_CODE_INVALID_TIMESTAMP$ ERROR_MSG_INVALID_TIMESTAMP ERROR_DETAIL_INVALID_TIMESTAMP "DD/MM/YYYY HH:mm:SS.mss"\r
+ end\r
+ \r
+ move (left(inTs,(pos(" ",inTs)-1))) to l_date\r
+ if (length(inTs) >= 13) move (mid(inTs, 2, 12)) to l_hr\r
+ else move 0 to l_hr\r
+ if (length(inTs) >= 16) move (mid(inTs, 2, 15)) to l_min\r
+ else move 0 to l_min\r
+ if (length(inTs) >= 19) move (mid(inTs, 2, 18)) to l_sec\r
+ else move 0 to l_sec\r
+ if (length(inTs) >= 21) move (mid(inTs, 3, 21)) to l_msec\r
+ else move 0 to l_msec\r
+ \r
+ if ((l_hr > 23) or (l_min > 59) or (l_sec > 59) or (l_msec > 999);\r
+ or (l_hr < 0) or (l_min < 0) or (l_sec < 0) or (l_msec < 0)) begin\r
+ custom_error ERROR_CODE_INVALID_TIMESTAMP$ ERROR_MSG_INVALID_TIMESTAMP\r
+ end\r
+ \r
+ calc (((integer(l_date))-(integer(date("01/01/1970"))))*86400) to l_posix\r
+ calc (((((l_hr*60)+l_min)*60)+l_sec)+(l_msec/1000)+l_posix) to l_posix\r
+ \r
+ function_return l_posix\r
+end_function\r
+\r
+// Convert a posix number to a textual timestamp\r
+function posix_to_timestamp global number argv returns string\r
+ local date l_date\r
+ local number l_subt \r
+ local integer l_hr l_min l_sec l_msec\r
+ local string l_posix_reverse\r
+ \r
+ // leap seconds not coded\r
+ calc ((argv/86400)+(integer(date("01/01/1970")))) to l_date\r
+ calc (argv-(((integer(l_date))-(integer(date("01/01/1970"))))*86400)) to l_subt\r
+ calc (l_subt/3600) to l_hr\r
+ calc ((l_subt-(l_hr*3600))/60) to l_min\r
+ calc (l_subt-(((l_hr*60)+l_min)*60)) to l_sec\r
+ calc ((l_subt-((((l_hr*60)+l_min)*60)+l_sec))*1000) to l_msec\r
+ \r
+ if ((l_hr > 23) or (l_min > 59) or (l_sec > 59) or (l_msec > 999);\r
+ or (l_hr < 0) or (l_min < 0) or (l_sec < 0) or (l_msec < 0)) begin\r
+ custom_error ERROR_CODE_INVALID_POSIX_NUMBER$ ERROR_MSG_INVALID_POSIX_NUMBER argv\r
+ end \r
+ \r
+ move "" to l_posix_reverse\r
+ move (string(l_date)+" "+zeropad(l_hr,2)+":"+zeropad(l_min,2)+":"+zeropad(l_sec,2)+"."+zeropad(l_msec,3)) to l_posix_reverse\r
+ \r
+ function_return l_posix_reverse\r
+end_function\r
+\r
+// Adjust supplied timestamp by supplied milliseconds\r
+function timestamp_adjust global string inTs number inMSeconds returns string\r
+ local string retTimestamp\r
+ local number nPosix\r
+ \r
+ move (timestemp_to_posix(inTs)) to nPosix\r
+ move (posix_to_timestamp(nPosix+(inMSeconds/1000))) to retTimestamp\r
+ \r
+ function_return retTimestamp\r
+end_function\r
+\r
+// Limited as we'd need to know the actual timestamp referred to to do months, years etc.\r
+// Supports millisecond, second, minute, hour, day, week\r
+function interval_to_posix global string argv returns number\r
+ local number l_value l_return\r
+ local integer l_i\r
+ local string l_unit l_interval l_numerics\r
+ \r
+ move (trim(argv)) to l_interval\r
+ move 0 to l_return\r
+ \r
+ if (length(l_interval) <> 0) begin\r
+ move 1 to l_i\r
+ while (l_i < length(l_interval))\r
+ move 0 to l_value\r
+ move "" to l_numerics\r
+ move "" to l_unit\r
+ while ((ascii(mid(l_interval, 1, l_i)) > 47) and (ascii(mid(l_interval, 1, l_i)) < 58))\r
+ append l_numerics (mid(l_interval, 1, l_i))\r
+ increment l_i\r
+ loop\r
+ while (ascii(mid(l_interval, 1, l_i)) = 32)\r
+ increment l_i\r
+ loop\r
+\r
+ while ((ascii(mid(l_interval, 1, l_i)) > 64) and (ascii(mid(l_interval, 1, l_i)) < 91);\r
+ or (ascii(mid(l_interval, 1, l_i)) > 96) and (ascii(mid(l_interval, 1, l_i)) < 123))\r
+ append l_unit (mid(l_interval, 1, l_i))\r
+ increment l_i\r
+ loop\r
+\r
+ move (lowercase(trim(l_unit))) to l_unit \r
+ case begin\r
+ case ((mid(l_unit,11,1) = "millisecond") or (mid(l_unit,2,1) = "ms")) move (l_numerics/number(1000)) to l_value\r
+ case break\r
+ case ((mid(l_unit,6,1) = "second") or (mid(l_unit,1,1) = "s")) move l_numerics to l_value\r
+ case break\r
+ case ((mid(l_unit,6,1) = "minute") or (mid(l_unit,1,1) = "m")) move (l_numerics*60) to l_value\r
+ case break \r
+ case ((mid(l_unit,4,1) = "hour") or (mid(l_unit,1,1) = "h")) move (l_numerics*3600) to l_value \r
+ case break \r
+ case ((mid(l_unit,3,1) = "day") or (mid(l_unit,1,1) = "d")) move (l_numerics*86400) to l_value\r
+ case break \r
+ case ((mid(l_unit,4,1) = "week") or (mid(l_unit,1,1) = "w")) move (l_numerics*604800) to l_value\r
+ case break \r
+ case end\r
+\r
+ move (l_return+l_value) to l_return\r
+ loop\r
+ end\r
+ \r
+ function_return l_return\r
+end_function\r
+\r
+// Adjust supplied timestamp by supplied interval\r
+// Supports microsecond, millisecond, second, minute, hour, day, week, month, year, decade, century, millennium\r
+// Negative sinage is indicated by "ago", words without preceeding units are treated as noise. E.g:\r
+// timestamp_adjust_interval("28/02/2009 09:00:00.000", "1century 2years 1month 1day 1hour 1minute 1second and 500 milliseconds ago")\r
+// Note that actual timestamps will be bound by posix and dataflex timestamp implementations.\r
+function timestamp_adjust_interval global string inTs string inInterval returns string\r
+ local string retTimestamp tmpTimestamp l_unit l_interval l_numerics\r
+ local number nPosix l_value l_return l_year l_mon l_day\r
+ local integer l_i l_iThrow l_iSign\r
+ \r
+ if ((length(inTs) < 10) or (mid(inTs, 1, 3) <> "/") or (mid(inTs, 1, 6) <> "/")) begin\r
+ custom_error ERROR_CODE_INVALID_TIMESTAMP$ ERROR_MSG_INVALID_TIMESTAMP ERROR_DETAIL_INVALID_TIMESTAMP "DD/MM/YYYY"\r
+ end\r
+ \r
+ move (mid(inTs, 2, 1)) to l_day\r
+ move (mid(inTs, 2, 4)) to l_mon\r
+ move (mid(inTs, 4, 7)) to l_year\r
+ \r
+ if (lowercase(inInterval) contains "ago");\r
+ move -1 to l_iSign\r
+ else;\r
+ move 1 to l_iSign\r
+ \r
+ move (trim(inInterval)) to l_interval\r
+ move 0 to l_return\r
+ \r
+ if (length(l_interval) <> 0) begin\r
+ move 1 to l_i\r
+ while (l_i < length(l_interval))\r
+ move 0 to l_value\r
+ move "" to l_numerics\r
+ move "" to l_unit\r
+ while ((ascii(mid(l_interval, 1, l_i)) > 47) and (ascii(mid(l_interval, 1, l_i)) < 58))\r
+ append l_numerics (mid(l_interval, 1, l_i))\r
+ increment l_i\r
+ loop\r
+ while (ascii(mid(l_interval, 1, l_i)) = 32)\r
+ increment l_i\r
+ loop\r
+ while ((ascii(mid(l_interval, 1, l_i)) > 64) and (ascii(mid(l_interval, 1, l_i)) < 91);\r
+ or (ascii(mid(l_interval, 1, l_i)) > 96) and (ascii(mid(l_interval, 1, l_i)) < 123))\r
+ append l_unit (mid(l_interval, 1, l_i))\r
+ increment l_i\r
+ loop\r
+ move (lowercase(trim(l_unit))) to l_unit \r
+ case begin\r
+ case ((mid(l_unit,10,1) = "millennium") or (mid(l_unit,6,1) = "millen")) move (l_year+(l_numerics*1000*l_iSign)) to l_year\r
+ case break\r
+ case ((mid(l_unit,7,1) = "century") or (mid(l_unit,1,1) = "c")) move (l_year+(l_numerics*100*l_iSign)) to l_year\r
+ case break\r
+ case ((mid(l_unit,6,1) = "decade") or (mid(l_unit,3,1) = "dec")) move (l_year+(l_numerics*10*l_iSign)) to l_year\r
+ case break\r
+ case ((mid(l_unit,4,1) = "year") or (mid(l_unit,1,1) = "y")) move (l_year+(l_numerics*l_iSign)) to l_year\r
+ case break\r
+ case ((mid(l_unit,5,1) = "month") or (mid(l_unit,3,1) = "mon")) move (l_mon+(l_numerics*l_iSign)) to l_mon\r
+ case break\r
+ case ((mid(l_unit,11,1) = "millisecond") or (mid(l_unit,2,1) = "ms")) move (l_numerics/number(1000)) to l_value\r
+ case break\r
+ case ((mid(l_unit,6,1) = "second") or (mid(l_unit,1,1) = "s")) move l_numerics to l_value\r
+ case break\r
+ case ((mid(l_unit,6,1) = "minute") or (mid(l_unit,3,1) = "min")) move (l_numerics*60) to l_value\r
+ case break \r
+ case ((mid(l_unit,4,1) = "hour") or (mid(l_unit,1,1) = "h")) move (l_numerics*3600) to l_value \r
+ case break \r
+ case ((mid(l_unit,3,1) = "day") or (mid(l_unit,1,1) = "d")) move (l_numerics*86400) to l_value\r
+ case break \r
+ case ((mid(l_unit,4,1) = "week") or (mid(l_unit,1,1) = "w")) move (l_numerics*604800) to l_value\r
+ case break \r
+ case end\r
+ move (l_return+l_value) to l_return\r
+ loop\r
+ end \r
+ \r
+ move (timestemp_to_posix(zeropad(l_day,2)+"/"+zeropad(l_mon,2)+"/"+zeropad(l_year,4)+mid(inTs,length(inTs)-10,11))) to nPosix\r
+ move (posix_to_timestamp(nPosix+(l_return*l_iSign))) to retTimestamp\r
+ \r
+ function_return retTimestamp\r
+end_function\r
+\r
+// This takes the day of the week and month occourance values from a SYSTEMTIME \r
+// in a _TIME_ZONE_INFORMATION and works out the correct day of the month\r
+// See description under "DaylightDate" here https://msdn.microsoft.com/en-us/library/ms724253.aspx\r
+function get_day_of_month_for_daylight_savings global integer inYear integer inMonth integer inDayOfWeek integer inDay returns integer\r
+ local integer l_dom l_i\r
+ local date l_date\r
+ \r
+ if (inDayOfWeek = 0) move 7 to inDayOfWeek\r
+ \r
+ move ("01/"+zeropad(inMonth,2)+"/"+zeropad(inYear,4)) to l_date\r
+ \r
+ while (get_day_score(l_date) <> inDayOfWeek)\r
+ increment l_date\r
+ loop\r
+ \r
+ if (integer(mid(l_date, 2, 4)) = inMonth);\r
+ move (mid(l_date, 2, 1)) to l_dom \r
+ \r
+ for l_i from 1 to (inDay-1)\r
+ calc (l_date+7) to l_date\r
+ \r
+ if (integer(mid(l_date, 2, 4)) = inMonth);\r
+ move (mid(l_date, 2, 1)) to l_dom \r
+ loop\r
+ \r
+ function_return l_dom\r
+end_function\r
+\r
+// Get local system time and starts to pull values to adjust to UTC (needs finishing)\r
+function systemtime_utc global returns string\r
+ local string sSystemTime sTimeZoneInformation sStdName sDlName sFormattedTime sFormattedDate sTs\r
+ local integer iSuccess iBias iStdBias iDlBias iBiasNow iLenCcTime iLenCcDate iDataLength\r
+ local pointer lpSystemTime lpTimeZoneInformation lpsFormattedTime lpsFormattedDate\r
+\r
+ // Get the current system local time\r
+ zerotype _SYSTEMTIME to sSystemTime\r
+ getaddress of sSystemTime to lpSystemTime\r
+\r
+ move (GetSystemTime(lpSystemTime)) to iSuccess\r
+\r
+ if (iSuccess <> 0) begin\r
+ // Get the current system timezone information\r
+ zerotype _TIME_ZONE_INFORMATION to sTimeZoneInformation\r
+ getaddress of sTimeZoneInformation to lpTimeZoneInformation\r
+\r
+ move (GetTimeZoneInformation(lpTimeZoneInformation)) to iSuccess\r
+ \r
+ if (iSuccess = TIME_ZONE_ID_INVALID) begin\r
+ custom_error ERROR_CODE_INVALID_SYSTEM_TIMEZONE$ ERROR_MSG_INVALID_SYSTEM_TIMEZONE\r
+ end\r
+ else begin\r
+ getbuff from sTimeZoneInformation at TIME_ZONE_INFORMATION.Bias to iBias\r
+ move (cstring(to_ascii(mid(sTimeZoneInformation, 64, 5)))) to sStdName //getbuff from sTimeZoneInformation at TIME_ZONE_INFORMATION.StandardName to sStdName //UTF-16/wchar \r
+ getbuff from sTimeZoneInformation at TIME_ZONE_INFORMATION.StandardBias to iStdBias\r
+ move (cstring(to_ascii(mid(sTimeZoneInformation, 64, 89)))) to sDlName //getbuff from sTimeZoneInformation at TIME_ZONE_INFORMATION.DaylightName to sDlName //UTF-16/wcharsDlName \r
+ getbuff from sTimeZoneInformation at TIME_ZONE_INFORMATION.DaylightBias to iDlBias\r
+\r
+ zerostring 255 to sFormattedTime\r
+ getaddress of sFormattedTime to lpsFormattedTime\r
+ move (length(sFormattedTime)) to iLenCcTime\r
+ move (GetTimeFormat("LOCALE_USER_DEFAULT", 0, lpSystemTime, 0, lpsFormattedTime, iLenCcTime)) to iDataLength \r
+\r
+ zerostring 255 To sFormattedDate\r
+ getaddress of sFormattedDate To lpsFormattedDate\r
+ move (length(sFormattedDate)) to iLenCcDate\r
+ move (GetDateFormat("LOCALE_USER_DEFAULT", 0, lpSystemTime, 0, lpsFormattedDate, iLenCcDate)) to iDataLength\r
+\r
+ // Work out bias and apply to get UTC\r
+ if (iSuccess = TIME_ZONE_ID_DAYLIGHT) begin\r
+ move (iBias+iDlBias) to iBiasNow\r
+ end\r
+ else begin\r
+ move (iBias+iStdBias) to iBiasNow\r
+ end\r
+ \r
+ move (cstring(sFormattedDate) * cstring(sFormattedTime)) to sTs\r
+ move (timestamp_adjust(sTs, iBiasNow*60000)) to sTs\r
+ end\r
+ end\r
+\r
+ function_return sTs\r
+end_function\r
+\r
+// Returns UTC BIAS in minutes\r
+function get_bias global string inDestTz integer inYear integer inMon integer inDay integer inHr integer inMin integer inSec integer inIsUTC returns integer\r
+ local string sTimeZone sResult sBuf sDaylightDate sDaylightTime sStandardDate sStandardTime StdTs DltTs inTs\r
+ local integer iSuccess iBiasNow iBias iStdBias iDaylightBias iIsDaylightSaving iThrow iTmp\r
+ local integer iEYear iEMon iEDay iEDOW iEHr iEMin iESec iBYear iBMon iBDay iBDOW iBHr iBMin iBSec iEDOM iBDOM\r
+ local number nTO nBO nEO StdPo DltPo inPo\r
+ local pointer lpTimeZone lpResult\r
+\r
+ ASSERT ((inIsUTC >= 0) and (inIsUTC <= 1)) "Unsupported mode, inIsUTC must be either 1 or 0"\r
+ \r
+ move 0 to iIsDaylightSaving\r
+ move (trim(inDestTz)) to sTimeZone \r
+ \r
+ if (sTimeZone <> "") begin\r
+ if (show_debug_lines = 1);\r
+ showln "Timezone: " sTimeZone\r
+ \r
+ getaddress of sTimeZone to lpTimeZone\r
+ \r
+ zerostring 128 to sResult\r
+ getaddress of sResult to lpResult\r
+ \r
+ move (GetTzi(lpTimeZone, lpResult)) to iSuccess\r
+ \r
+ if (iSuccess = -1) begin\r
+ \r
+ send set_string to (tzTok(current_object)) sResult ","\r
+ get token_value of (tzTok(current_object)) item 0 to iBias\r
+ get token_value of (tzTok(current_object)) item 1 to iStdBias\r
+ get token_value of (tzTok(current_object)) item 2 to iDaylightBias\r
+ get token_value of (tzTok(current_object)) item 3 to sStandardDate\r
+ get token_value of (tzTok(current_object)) item 4 to sStandardTime\r
+ get token_value of (tzTok(current_object)) item 5 to sDaylightDate\r
+ get token_value of (tzTok(current_object)) item 6 to sDaylightTime\r
+ \r
+ // Once all of our data has been retrieved we need to determine daylight saving time\r
+ //showln sDaylightDate " " sDaylightTime " = " sStandardDate " " sStandardTime\r
+\r
+ send set_string to (tzTok(current_object)) sDaylightDate "/" \r
+ get token_value of (tzTok(current_object)) item 0 to iBYear\r
+ get token_value of (tzTok(current_object)) item 1 to iBMon\r
+ get token_value of (tzTok(current_object)) item 2 to iBDay\r
+ get token_value of (tzTok(current_object)) item 3 to iBDOW\r
+ \r
+ send set_string to (tzTok(current_object)) sStandardDate "/" \r
+ get token_value of (tzTok(current_object)) item 0 to iEYear\r
+ get token_value of (tzTok(current_object)) item 1 to iEMon\r
+ get token_value of (tzTok(current_object)) item 2 to iEDay\r
+ get token_value of (tzTok(current_object)) item 3 to iEDOW\r
+ \r
+ ASSERT ((iBMon <> 0) and (iEMon <> 0)) "Daylight saving not supported"\r
+ \r
+ if (show_debug_lines = 1) begin\r
+ if ((iBMon = 0) or (iEMon = 0));\r
+ showln "Supports Dls: no" \r
+ else;\r
+ showln "Supports Dls: yes" \r
+ end \r
+ \r
+ if ((iBMon <> 0) and (iEMon <> 0)) begin\r
+ if ((iBYear = 0) or (iBYear = inYear)) begin\r
+ \r
+ move (get_day_of_month_for_daylight_savings((iBYear max inYear),iBMon,iBDOW,iBday)) to iBDOM\r
+ move (get_day_of_month_for_daylight_savings((iEYear max inYear),iEMon,iEDOW,iEday)) to iEDOM \r
+ \r
+ send set_string to (tzTok(current_object)) sDaylightTime ":"\r
+ get token_value of (tzTok(current_object)) item 0 to iBHr\r
+ get token_value of (tzTok(current_object)) item 1 to iBMin\r
+ get token_value of (tzTok(current_object)) item 2 to iBSec\r
+\r
+ send set_string to (tzTok(current_object)) sStandardTime ":"\r
+ get token_value of (tzTok(current_object)) item 0 to iEHr\r
+ get token_value of (tzTok(current_object)) item 1 to iEMin\r
+ get token_value of (tzTok(current_object)) item 2 to iESec\r
+\r
+ move (zeropad(iBDOM,2)+"/"+zeropad(iBMon,2)+"/"+string(iEYear max inYear)+" "+zeropad(iBHr,2)+":"+zeropad(iBMin,2)+":"+zeropad(iBSec,2)) to DltTs\r
+ move (zeropad(iEDOM,2)+"/"+zeropad(iEMon,2)+"/"+string(iEYear max inYear)+" "+zeropad(iEHr,2)+":"+zeropad(iEMin,2)+":"+zeropad(iESec,2)) to StdTs\r
+ move (zeropad(inDay,2)+"/"+zeropad(inMon,2)+"/"+string(inYear)+" "+zeropad(inHr,2)+":"+zeropad(inMin,2)+":"+zeropad(inSec,2)) to inTs\r
+ \r
+ move (timestemp_to_posix(DltTs)) to DltPo\r
+ move (timestemp_to_posix(StdTs)) to StdPo\r
+ move (timestemp_to_posix(inTs)+(iBias*-60*inIsUTC)) to inPo\r
+ \r
+ if (show_debug_lines = 1) begin\r
+ showln "InTimestamp: " inTs\r
+ showln "CmpTimestamp: " (posix_to_timestamp(inPo))\r
+ showln "DaylightTimestamp: " DltTs " Offset=" (iBias+iDaylightBias) \r
+ showln "StandardTimestamp: " StdTs " Offset=" (iBias+iStdBias)\r
+ end\r
+ \r
+ if (DltPo < StdPo) begin\r
+ if ((inPo >= DltPo) and (inPo < StdPo)) move 1 to iIsDaylightSaving\r
+ end\r
+ else begin\r
+ if not ((inPo >= StdPo) and (inPo < DltPo)) move 1 to iIsDaylightSaving\r
+ end\r
+ end\r
+ \r
+ end\r
+ \r
+ // If the clocks go forward at 1.00am then the 1.00am-1.59am doesn't exist in localtime; \r
+ // conversins back and forth between nonexistent times will look wrong, but should never occour\r
+ // If the clocks go back at 1.00am then 1.00am effectively occours twice \r
+ // More info: http://www.timeanddate.com/time/dst/transition.html\r
+ \r
+ // Now we can figure out the actual bias\r
+ if (iIsDaylightSaving = 1) begin\r
+ move (iBias+iDaylightBias) to iBiasNow\r
+ if (show_debug_lines = 1) begin\r
+ showln "Zone currently in daylight saving"\r
+ end\r
+ end\r
+ else begin\r
+ move (iBias+iStdBias) to iBiasNow\r
+ end\r
+ if (show_debug_lines = 1) begin\r
+ showln "Bias: " iBiasNow\r
+ end\r
+ \r
+ send destroy_object to tzTok\r
+ end\r
+ else begin\r
+ custom_error ERROR_CODE_INVALID_TIMESTAMP$ ERROR_MSG_INVALID_TIMESTAMP\r
+ end \r
+ end\r
+\r
+ function_return iBiasNow\r
+end_function\r
+\r
+// Returns UTC time converted from the current time in the passed timezone \r
+function get_utc_time_from_timezone_time global string inDestTz string inTs returns string\r
+ local integer l_bias\r
+ local string l_ts\r
+ local integer inGmtYear inGmtMon inGmtDay inGmtHr inGmtMin inGmtSec \r
+\r
+ if ((length(inTs) < 10) or (mid(inTs, 1, 3) <> "/") or (mid(inTs, 1, 6) <> "/") or (mid(inTs, 1, 11) <> " ")) begin\r
+ custom_error ERROR_CODE_INVALID_TIMESTAMP$ ERROR_MSG_INVALID_TIMESTAMP ERROR_DETAIL_INVALID_TIMESTAMP "DD/MM/YYYY"\r
+ end\r
+ if (((length(inTs) >= 16) and (mid(inTs, 1, 14) <> ":")) or ((length(inTs) >= 19) and (mid(inTs, 1, 17) <> ":"));\r
+ or ((length(inTs) >= 21) and (mid(inTs, 1, 20) <> "."))) begin\r
+ custom_error ERROR_CODE_INVALID_TIMESTAMP$ ERROR_MSG_INVALID_TIMESTAMP ERROR_DETAIL_INVALID_TIMESTAMP "DD/MM/YYYY HH:mm:SS.mss"\r
+ end\r
+ \r
+ move (mid(inTs, 2, 1)) to inGmtDay\r
+ move (mid(inTs, 2, 4)) to inGmtMon\r
+ move (mid(inTs, 4, 7)) to inGmtyear\r
+ \r
+ if (length(inTs) >= 13) move (mid(inTs, 2, 12)) to inGmtHr\r
+ else move 0 to inGmtHr\r
+ if (length(inTs) >= 16) move (mid(inTs, 2, 15)) to inGmtMin\r
+ else move 0 to inGmtMin\r
+ if (length(inTs) >= 19) move (mid(inTs, 2, 18)) to inGmtSec\r
+ else move 0 to inGmtSec\r
+ \r
+ move (get_bias(inDestTz, inGmtYear, inGmtMon, inGmtDay, inGmtHr, inGmtMin, inGmtSec, 0)) to l_bias\r
+ move (zeropad(inGmtDay,2)+"/"+zeropad(inGmtMon,2)+"/"+zeropad(inGmtYear,4)+" "+zeropad(inGmtHr,2)+":"+zeropad(inGmtMin,2)+":"+zeropad(inGmtSec,2)) to l_ts\r
+ \r
+ move (timestamp_adjust(l_ts, l_bias*60000)) to l_ts\r
+ \r
+ function_return l_ts\r
+end_function\r
+\r
+//Returns current time in the passed timezone from the time passed as UTC\r
+function get_timezone_time_from_utc_time global string inDestTz string inTs returns string\r
+ local integer l_bias\r
+ local string l_ts\r
+ local integer inUtcYear inUtcMonth inUtcDay inUtcHr inUtcMin inUtcSec \r
+\r
+ if ((length(inTs) < 10) or (mid(inTs, 1, 3) <> "/") or (mid(inTs, 1, 6) <> "/") or (mid(inTs, 1, 11) <> " ")) begin\r
+ custom_error ERROR_CODE_INVALID_TIMESTAMP$ ERROR_MSG_INVALID_TIMESTAMP ERROR_DETAIL_INVALID_TIMESTAMP "DD/MM/YYYY"\r
+ end\r
+ if (((length(inTs) >= 16) and (mid(inTs, 1, 14) <> ":")) or ((length(inTs) >= 19) and (mid(inTs, 1, 17) <> ":"));\r
+ or ((length(inTs) >= 21) and (mid(inTs, 1, 20) <> "."))) begin\r
+ custom_error ERROR_CODE_INVALID_TIMESTAMP$ ERROR_MSG_INVALID_TIMESTAMP ERROR_DETAIL_INVALID_TIMESTAMP "DD/MM/YYYY HH:mm:SS.mss"\r
+ end\r
+ \r
+ move (mid(inTs, 2, 1)) to inUtcDay\r
+ move (mid(inTs, 2, 4)) to inUtcMonth\r
+ move (mid(inTs, 4, 7)) to inUtcyear\r
+ \r
+ if (length(inTs) >= 13) move (mid(inTs, 2, 12)) to inUtcHr\r
+ else move 0 to inUtcHr\r
+ if (length(inTs) >= 16) move (mid(inTs, 2, 15)) to inUtcMin\r
+ else move 0 to inUtcMin\r
+ if (length(inTs) >= 19) move (mid(inTs, 2, 18)) to inUtcSec\r
+ else move 0 to inUtcSec\r
+ \r
+ move (get_bias(inDestTz, inUtcYear, inUtcMonth, inUtcDay, inUtcHr, inUtcMin, inUtcSec, 1)) to l_bias\r
+ move (zeropad(inUtcDay,2)+"/"+zeropad(inUtcMonth,2)+"/"+zeropad(inUtcYear,4)+" "+zeropad(inUtcHr,2)+":"+zeropad(inUtcMin,2)+":"+zeropad(inUtcSec,2)) to l_ts\r
+ \r
+ move (timestamp_adjust(l_ts, l_bias*-60000)) to l_ts\r
+ \r
+ function_return l_ts\r
+end_function\r
+\r
+//Convert a timestamp from one local zone to another\r
+function get_timezone_time_from_timezone_time global string inSourceTz string inDestTz string inTs returns string\r
+ local string l_ts\r
+ \r
+ move (get_timezone_time_from_utc_time(inDestTz, (get_utc_time_from_timezone_time(inSourceTz, inTs)))) to l_ts\r
+ \r
+ function_return l_ts\r
+end_function\r
+\r
--- /dev/null
+//-------------------------------------------------------------------------\r
+// win32.h\r
+// This file contains definitions of "Win32" api functions as well as\r
+// their related constants and structs. These functions are exposed as\r
+// dynamic link libraries provided on systems running Windows XP or greater.\r
+//\r
+// This file is to be included when using Win32 capabilities in df32func.mk\r
+//\r
+// Copyright (c) 2006-2009, glyn@8kb.co.uk\r
+// \r
+// df32func/win32.h\r
+//-------------------------------------------------------------------------\r
+\r
+Define __win32_h__\r
+\r
+//-------------------------------------------------------------------------\r
+// External functions\r
+//-------------------------------------------------------------------------\r
+\r
+external_function GetDateFormat "GetDateFormatA" kernel32.dll dword LCID dword dwFlags pointer lpsSystemTime pointer lpFormat pointer lpDateStr integer cchDate returns integer\r
+external_function GetTimeFormat "GetTimeFormatA" kernel32.dll dword LCID dword dwFlags pointer lpsSystemTime pointer lpFormat pointer lpTimeStr integer cchTime returns integer\r
+external_function GetFileTime "GetFileTime" kernel32.dll handle hFileHandle pointer lpCreationTime pointer lpLastAccessTime pointer lpLastWriteTime returns integer\r
+external_function FileTimeToSystemTime "FileTimeToSystemTime" kernel32.dll pointer lpFileTime Pointer lpSystemTime returns integer\r
+external_function FileTimeToLocalFileTime "FileTimeToLocalFileTime" kernel32.dll pointer lpFileTime Pointer lpSystemTime returns integer\r
+external_function FindFirstFile "FindFirstFileA" kernel32.dll pointer lpFileName pointer lpFindFileData returns handle\r
+external_function FindNextFile "FindNextFileA" kernel32.dll handle hFindFile pointer lpFindFileData returns integer\r
+external_function FindClose "FindClose" kernel32.dll handle hFindFile returns integer\r
+external_function LockFile "LockFile" kernel32.dll handle hFile dword dwFileOffsetLow dword dwFileOffsetHigh dword nNumberOfBytesToLockLow dword nNumberOfBytesToLockHigh returns integer\r
+external_function UnlockFile "UnlockFile" kernel32.dll handle hFile dword dwFileOffsetLow dword dwFileOffsetHigh dword nNumberOfBytesToLockLow dword nNumberOfBytesToLockHigh returns integer\r
+external_function SHFileOperation "SHFileOperationA" shell32.dll pointer lpFileOp returns integer\r
+external_function32 GetTempPath "GetTempPathA" kernel32.dll integer nBufferLength pointer lpBuffer_ptr returns integer\r
+external_function GetSystemDirectory "GetSystemDirectoryA" kernel32.dll pointer lpBuffer integer uSize returns integer\r
+external_function32 mciSendString "mciSendStringA" winmm.dll pointer lpstrCommand pointer lpstrReturnString integer uReturnLength integer hwndCallback returns integer\r
+external_function ExitProcessEx "ExitProcess" Kernel32.dll integer iExitCode returns integer\r
+external_function GetComputername "GetComputerNameA" kernel32.dll pointer sBuffer pointer lSize returns integer\r
+external_function WNetGetUser "WNetGetUserA" MPR.dll pointer lpName pointer lpUserName string lpnLength returns DWord\r
+external_function SHBrowseForFolder "SHBrowseForFolder" shell32.dll pointer lpsBrowseInfo returns dword\r
+external_function SHGetPathFromIDList "SHGetPathFromIDList" shell32.dll pointer pidList pointer lpBuffer returns dWord\r
+external_function CoTaskMemFree "CoTaskMemFree" ole32.dll pointer pV returns integer\r
+external_function GetPID "_getpid" msvcrt.dll returns integer\r
+external_function getShortPathName "GetShortPathNameA" kernel32.dll pointer lpszLongPath pointer lpszShortPath integer cchBuffer returns integer\r
+external_function SetConsoleTitle "SetConsoleTitleA" Kernel32.dll string lpszTitle returns integer\r
+external_function FindWindow "FindWindowA" user32.dll pointer lpszClassName string lpszWindowName returns handle\r
+external_function GetSystemMenu "GetSystemMenu" user32.dll handle hwnd dword bRevert returns dword\r
+external_function EnableMenuItem "EnableMenuItem" user32.dll handle hmenu integer uIDEnableItem integer uEnable returns integer\r
+external_function ShellExecute "ShellExecuteA" shell32.dll handle hWnd pointer lpOperation pointer lpFile pointer lpParameters pointer lpDirectory integer nShowCmd returns integer\r
+external_function CreateProcess "CreateProcessA" kernel32.dll pointer lpAN pointer lpCL pointer lpPA pointer lpTA integer bIH dword dwCF pointer lpE pointer lpCD pointer lpSI pointer lpPi returns integer\r
+external_function OpenProcess "OpenProcess" kernel32.dll dword dwDesiredAccessas integer bInheritHandle dword dwProcId returns handle\r
+external_function TerminateProcess "TerminateProcess" kernel32.dll handle hProcess integer uExitCode returns integer\r
+external_function CloseHandle "CloseHandle" kernel32.dll handle hObject returns integer\r
+external_function WaitForSingleObject "WaitForSingleObject" kernel32.dll handle hHandle dword dwMilliseconds returns integer\r
+external_function32 Message_Beep "MessageBeep" user32.dll integer iSound returns integer\r
+external_function32 ExitWindowsEx "ExitWindowsEx" user32.dll integer uFlags integer dwReserved returns integer\r
+external_function lOpen "_lopen" kernel32.dll string lpPathName integer iReadWrite returns integer\r
+external_function lClose "_lclose" kernel32.dll handle hFile returns integer\r
+external_function GetLastError "GetLastError" kernel32.dll returns integer\r
+external_function CreateFile "CreateFileA" kernel32.dll pointer lpFNname dword dwDAccess dword dwSMode pointer lpSecAttrib dword dwCreationDisp dword dwFlagsAndAttrib handle hTemplateFile returns handle\r
+external_function GetFileSize "GetFileSize" kernel32.dll handle hFile pointer lpFileSizeHigh returns integer\r
+external_function SetFilePointer "SetFilePointer" kernel32.dll handle hFile dword lDistanceToMove pointer lpDistanceToMoveHigh dword dwMoveMethod returns handle\r
+external_function ReadFile "ReadFile" kernel32.dll handle hFile pointer lpBuffer integer nNumberOfBytesToRead pointer lpNumberOfBytesRead pointer lpOverlapped returns integer\r
+external_function CopyMemory "RtlMoveMemory" kernel32.dll pointer pDst pointer pSrc integer byteLen returns integer\r
+external_function EnumProcesses "EnumProcesses" psapi.dll pointer lpidProcess integer cb pointer cbNeeded returns integer\r
+external_function EnumProcessModules "EnumProcessModules" psapi.dll handle hProcess pointer lphModule integer cb integer cbNeeded returns integer\r
+external_function WideCharToMultiByte "WideCharToMultiByte" kernel32.dll integer cp dword dwF pointer lpWCS integer cchWC pointer lpMBS integer cchMB string dC string uDC returns integer\r
+external_function GetSystemTime "GetSystemTime" kernel32.dll Pointer lpGST returns VOID_TYPE\r
+external_function GetTickCount "GetTickCount" kernel32.dll returns dWord\r
+external_function32 CoCreateGuid "CoCreateGuid" ole32.dll pointer pGUIDStructure returns word\r
+external_function32 StringFromGUID2 "StringFromGUID2" ole32.dll pointer pGUIDStructure pointer lpstrClsId integer cbMax returns dword\r
+external_function MsiQueryProductState "MsiQueryProductStateA" msi.dll string szProduct returns integer\r
+external_function MilliSleep "Sleep" kernel32.dll integer dwMilliseconds returns integer\r
+external_function SetLastError "SetLastError" kernel32.dll dword dwErrCode returns integer\r
+external_function FormatMessage "FormatMessageA" kernel32.dll integer dwFlags pointer lpSource dword dwMessageId dword dwLanguageId pointer lpBuffer integer nSize dword Arguments returns integer\r
+external_function GetProcessMemoryInfo "GetProcessMemoryInfo" PSAPI.DLL dword l_hProcess pointer ppsmemCounters dword cb returns integer\r
+external_function MultiByteToWideChar "MultiByteToWideChar" kernel32.dll integer cp dword dwF pointer lpWCS integer cchWC pointer lpMBS integer cchMB string dC string uDC returns integer\r
+external_function GetDiskFreeSpace "GetDiskFreeSpaceA" kernel32.dll string lpRootPathName pointer lpSectorsPC pointer lpBytesPS pointer lpNumberOfFreeClusters pointer lpTotalNOC returns integer\r
+external_function InternetCanonicalizeUrl "InternetCanonicalizeUrlA" wininet.dll pointer lpszUrl pointer lpszBuffer pointer lpdwBufferLength dword dwFlags returns integer\r
+external_function CryptAcquireContext "CryptAcquireContextA" advapi32.dll pointer phProv string pszContainer string pszProvider dword dwProvType dword dwFlags returns integer\r
+external_function CryptReleaseContext "CryptReleaseContext" advapi32.dll pointer phProv dword dwFlags returns integer\r
+external_function CryptCreateHash "CryptCreateHash" advapi32.dll handle hProv dword Algid handle hKey dword dwFlags pointer phHash returns integer\r
+external_function CryptDestroyHash "CryptDestroyHash" advapi32.dll handle hHash returns integer\r
+external_function CryptHashData "CryptHashData" advapi32.dll handle hHash pointer pbData dword dwDataLen dword dwFlags returns integer\r
+external_function CryptGetHashParam "CryptGetHashParam" advapi32.dll handle hHash dword dwParam pointer pbData pointer pdwDataLen dword dwFlags returns integer\r
+external_function CryptEnumProviders "CryptEnumProvidersA" advapi32.dll dword dwIndex pointer pdwReserved dword dwFlags pointer pdwProvType pointer pcbProvName pointer pszProvName returns integer\r
+external_function CryptBinaryToString "CryptBinaryToStringA" crypt32.dll dword pbBinary dword cbBinary dword dwFlags pointer pszString pointer pcchString returns integer\r
+external_function CryptGetProvParam "CryptGetProvParam" advapi32.dll handle hProv dword dwParam pointer pbData pointer pdwDataLen dword dwFlags returns integer\r
+external_function CryptContextAddRef "CryptGetProvParam" advapi32.dll handle hProv dword pdwReserved dword dwFlags returns integer\r
+external_function CryptImportKey "CryptImportKey" advapi32.dll handle hProv pointer pbData pointer pdwDataLen dword hPubKey dword dwFlags pointer phKey returns integer\r
+external_function CryptExportKey "CryptExportKey" advapi32.dll handle hKey handle hExpKey dword dwBlobType dword dwFlags pointer pbData pointer pdwDataLen returns integer\r
+external_function CryptDeriveKey "CryptDeriveKey" advapi32.dll handle hProv dword Algid handle hHash dword dwFlags pointer phKey returns integer\r
+external_function CryptDestroyKey "CryptDestroyKey" advapi32.dll handle hKey returns integer\r
+external_function CryptEncrypt "CryptEncrypt" advapi32.dll handle hKey handle hHash dword bFinal dword dwFlags pointer pbData pointer pdwDataLen dword dwBufLen returns integer\r
+external_function CryptDecrypt "CryptDecrypt" advapi32.dll handle hKey handle hHash dword bFinal dword dwFlags pointer pbData pointer pdwDataLen returns integer\r
+external_function CryptSetKeyParam "CryptSetKeyParam" advapi32.dll handle hKey dword dwParam pointer pbData dword dwFlags returns integer\r
+external_function CryptBinaryToString "CryptBinaryToStringA" crypt32.dll dword pbBinary dword cbBinary dword dwFlags pointer pszString pointer pcchString returns integer\r
+external_function CryptStringToBinary "CryptStringToBinaryA" crypt32.dll pointer pszString dword cchString dword dwFlags pointer pbBinary pointer pcbBinary pointer pdwSkip pointer pdwFlags returns integer\r
+external_function GetVersionEx "GetVersionExA" kernel32.dll pointer lpVersionInfo returns integer\r
+external_function GetSystemTime "GetSystemTime" kernel32.dll pointer lpSystemTime returns integer\r
+external_function GetTimeZoneInformation "GetTimeZoneInformation" kernel32.dll pointer lpTimeZoneInformation returns integer\r
+external_function GetTzi "GetTzi" timezone.dll pointer lpTimeZone pointer lpResult returns integer\r
+\r
+//-------------------------------------------------------------------------\r
+// Constants\r
+//-------------------------------------------------------------------------\r
+\r
+// MSI Constants\r
+#REPLACE INSTALLSTATE_UNKNOWN |CI$-0000001 // No action to be taken on the feature or component.\r
+#REPLACE INSTALLSTATE_BROKEN |CI$00000000 // The feature is broken\r
+#REPLACE INSTALLSTATE_ADVERTISED |CI$00000001 // Advertised feature\r
+#REPLACE INSTALLSTATE_ABSENT |CI$00000002 // The feature is not installed.\r
+#REPLACE INSTALLSTATE_LOCAL |CI$00000003 // The feature is installed locally.\r
+#REPLACE INSTALLSTATE_DEFAULT |CI$00000005 // The product is to be installed with all features installed to the default states specified in the Feature table.\r
+\r
+// MCI Constants\r
+#REPLACE SIMPLE_BEEP |CI$-0000001 // SimpleBeep = -1,\r
+#REPLACE WINMDOWS_OK |CI$00000000 // A standard windows OK beep = 0x00,\r
+#REPLACE WINDOWS_QUESTION |CI$00000020 // A standard windows Question beep = 0x20,\r
+#REPLACE WINDOWS_EXCLAMATION |CI$00000030 // A standard windows Exclamation beep = 0x30,\r
+#REPLACE WINDOWS_ASTERISK |CI$00000040 // A standard windows Asterisk beep = 0x40,\r
+\r
+// ExitWindowsEx Constants\r
+#REPLACE EWX_LOGOFF |CI$00000000 // logoff\r
+#REPLACE EWX_SHUTDOWN |CI$00000001 // shutdown\r
+#REPLACE EWX_REBOOT |CI$00000002 // Reboot\r
+#REPLACE EWX_FORCE |CI$00000004 // Force shutdown\r
+\r
+// SHFileOperation Constants\r
+#REPLACE MaxDword |CI$FFFFFFFF\r
+#REPLACE FO_COPY |CI$00000002 // FO_COPY &H2 Copies a file or folder\r
+#REPLACE FO_DELETE |CI$00000003 // FO_DELETE &H3 Deletes a file or folder\r
+#REPLACE FO_MOVE |CI$00000001 // FO_MOVE &H1 Moves a file or folder\r
+#REPLACE FO_RENAME |CI$00000004 // FO_RENAME &H4 Renames a file or folder\r
+#REPLACE FOF_ALLOWUNDO |CI$00000040 // FOF_ALLOWUNDO &H40 Used with Rename. When used with Delete the files get sent to the Recycle Bin.\r
+#REPLACE FOF_FILESONLY |CI$00000080 // FOF_FILESONLY &H80 Only allows files.\r
+#REPLACE FOF_NOCONFIRMATION |CI$00000010 // FOF_NOCONFIRMATION &H10 Does not display the Delete or Overwrite confirmation dialog.\r
+#REPLACE FOF_SILENT |CI$00000004 // FOF_SILENT &H4 Does not display the Windows animation while performing the opperation.\r
+#REPLACE FOF_SIMPLEPROGRESS |CI$00000100 // FOF_SIMPLEPROGRESS &H100 Does not display filenames.\r
+#REPLACE FOF_NOCOPYSECURITYATTRIBS |CI$00000800 // Do not copy NT file Security Attributes\r
+#REPLACE FOF_NOERRORUI |CI$00000400 // Do not display a dialog to the user if an error occurs.\r
+#REPLACE FOF_NOCONFIRMMKDIR |CI$00000200 // Do not ask the user to confirm the creation of a new directory if the operation requires one to be created\r
+\r
+// FolderBrowse Constants\r
+#REPLACE BIF_RETURNONLYFSDIRS |CI$00000001 // Window will only return when user selects a filesystem folder\r
+#REPLACE BIF_DONTGOBELOWDOMAIN |CI$00000002 // Do not include network folders below the domain level\r
+#REPLACE BIF_STATUSTEXT |CI$00000004 // Sets the window label to the chosen folder\r
+#REPLACE BIF_RETURNFSANCESTORS |CI$00000008 // Only return file system directories.\r
+#REPLACE BIF_EDITBOX |CI$00000010 // Show edit, so user can edit path\r
+#REPLACE BIF_BROWSEFORCOMPUTER |CI$00001000 // Only return computers\r
+#REPLACE BIF_BROWSEFORPRINTER |CI$00002000 // Only return printers\r
+#REPLACE BIF_BROWSEINCLUDEFILES |CI$00004000 // Display files as well as folders\r
+\r
+// GDI Window Constants\r
+#REPLACE SC_CLOSE |CI$0000F060\r
+#REPLACE MF_BYCOMMAND |CI1\r
+#REPLACE MF_ENABLED |CI0\r
+#REPLACE MF_GRAYED |CI1\r
+\r
+// ShellExecute Constants\r
+#REPLACE SW_HIDE |CI00 // Hides the window and activates another window;\r
+#REPLACE SW_MAXIMIZE |CI01 // Activates and displays a window. If the window is minimized or maximized, Windows restores it to its original size and position. An application should specify this flag when displaying the window for the first time.\r
+#REPLACE SW_MINIMIZE |CI02 // Minimizes the specified window and activates the next top-level window in the Z order\r
+#REPLACE SW_RESTORE |CI03 // Maximizes the specified window\r
+#REPLACE SW_SHOW |CI04 // Displays a window in its most recent size and position. The active window remains active.\r
+#REPLACE SW_SHOWDEFAULT |CI05 // Activates the window and displays it in its current size and position\r
+#REPLACE SW_SHOWMAXIMIZED |CI06 // Minimizes the specified window and activates the next top-level window in the Z order\r
+#REPLACE SW_SHOWMINIMIZED |CI07 // Displays the window as a minimized window. The active window remains active\r
+#REPLACE SW_SHOWMINNOACTIVE |CI08 // Displays the window in its current state. The active window remains active\r
+#REPLACE SW_SHOWNA |CI09 // Activates and displays the window. If the window is minimized or maximized, Windows restores it to its original size and position. An application should specify this flag when restoring a minimized window.\r
+#REPLACE SW_SHOWNOACTIVATE |CI10 // Displays a window in its most recent size and position. The active window remains active.\r
+#REPLACE SW_SHOWNORMAL |CI11 // Activates and displays a window. If the window is minimized or maximized, Windows restores it to its original size and position. An application should specify this flag when displaying the window for the first time.\r
+\r
+// CreateProcess constants\r
+#REPLACE SYNCHRONIZE |CI1048576\r
+#REPLACE NORMAL_PRIORITY_CLASS |CI$00000020\r
+#REPLACE HEXNULL |CI$00000000\r
+#REPLACE HEXTRUE |CI$00000001\r
+#REPLACE STRINGNULL |CS''\r
+#REPLACE INFINITE |CI$-0000001 // Wait until process terminates\r
+\r
+#REPLACE CREATE_NEW_CONSOLE |CI$00000010 // The new process has a new console, instead of inheriting the parent's console.\r
+#REPLACE CREATE_NEW_PROCESS_GROUP |CI$00000200 // Not supported.\r
+#REPLACE CREATE_SEPARATE_WOW_VDM |CI$00000800 // Not supported.\r
+#REPLACE CREATE_SHARED_WOW_VDM |CI$00001000 // Not supported.\r
+#REPLACE CREATE_SUSPENDED |CI$00000004 // The primary thread of the new process is created in a suspended state, and does not run until the ResumeThread function is called.\r
+#REPLACE CREATE_UNICODE_ENVIRONMENT |CI000000400 // Not supported.\r
+#REPLACE DEBUG_PROCESS |CI$00000001 // If this flag is set, the calling process is treated as a debugger, and the new process is a process being debugged. Child processes of the new process are also debugged.\r
+ // The system notifies the debugger of all debug events that occur in the process being debugged.\r
+ // If you create a process with this flag set, only the calling thread (the thread that called CreateProcess) can call the WaitForDebugEvent function.\r
+#REPLACE DEBUG_ONLY_THIS_PROCESS |CI$00000002 // If this flag is set, the calling process is treated as a debugger, and the new process is a process being debugged. No child processes of the new process are debugged.\r
+ // The system notifies the debugger of all debug events that occur in the process being debugged.\r
+#REPLACE DETACHED_PROCESS |CI$00000008 // Not supported.\r
+#REPLACE INHERIT_CALLER_PRIORITY |CI$00020000 // If this flag is set, the new process inherits the priority of the creator process.\r
+#REPLACE REALTIME_PRIORITY_CLASS |CI000000100\r
+#REPLACE HIGH_PRIORITY_CLASS |CI$00000080\r
+#REPLACE IDLE_PRIORITY_CLASS |CI$00000040\r
+\r
+// Readmode Constants\r
+#REPLACE OF_READ |CI$00000000\r
+#REPLACE OF_WRITE |CI$00000001\r
+#REPLACE OF_READWRITE |CI$00000002\r
+\r
+// Attribute Constants\r
+#REPLACE FILE_ATTRIBUTE_READONLY |CI$00000001\r
+#REPLACE FILE_ATTRIBUTE_HIDDEN |CI$00000002\r
+#REPLACE FILE_ATTRIBUTE_SYSTEM |CI$00000004\r
+#REPLACE FILE_ATTRIBUTE_DIRECTORY |CI$00000010\r
+#REPLACE FILE_ATTRIBUTE_ARCHIVE |CI$00000020\r
+#REPLACE FILE_ATTRIBUTE_NORMAL |CI$00000080\r
+#REPLACE FILE_ATTRIBUTE_TEMPORARY |CI$00000100\r
+#REPLACE FILE_ATTRIBUTE_ENCRYPTED |CI$00000040 // NT, Windows 2000 only\r
+#REPLACE FILE_ATTRIBUTE_OFFLINE |CI$00001000 // Windows 2000 only\r
+#REPLACE FILE_ATTRIBUTE_NOT_CONTENT_INDEXED |CI$00002000 // NT, Windows 2000 only\r
+\r
+// Sharemode Constants\r
+#REPLACE OF_SHARE_COMPAT |CI$00000000\r
+#REPLACE OF_SHARE_EXCLUSIVE |CI$00000010\r
+#REPLACE OF_SHARE_DENY_WRITE |CI$00000020\r
+#REPLACE OF_SHARE_DENY_READ |CI$00000030\r
+#REPLACE OF_SHARE_DENY_NONE |CI$00000040\r
+#REPLACE OF_PARSE |CI$00000100\r
+#REPLACE OF_DELETE |CI$00000200\r
+#REPLACE OF_VERIFY |CI$00000400\r
+#REPLACE OF_CANCEL |CI$00000800\r
+#REPLACE OF_CREATE |CI$00001000\r
+#REPLACE OF_PROMPT |CI$00002000\r
+#REPLACE OF_EXIST |CI$00004000\r
+#REPLACE OF_REOPEN |CI$00008000\r
+\r
+// Accessmode Constants\r
+#REPLACE FILE_SHARE_DELETE |CI$00000000\r
+#REPLACE FILE_SHARE_READ |CI$00000001\r
+#REPLACE FILE_SHARE_WRITE |CI$00000002\r
+#REPLACE FILE_BEGIN |CI0\r
+#REPLACE FILE_CURRENT |CI1\r
+#REPLACE FILE_END |CI2\r
+#REPLACE OPEN_EXISTING |CI3\r
+#REPLACE OPEN_ALWAYS |CI4\r
+#REPLACE TRUNCATE_EXISTING |CI5\r
+#REPLACE GENERIC_READ |CI$80000000\r
+#REPLACE GENERIC_WRITE |CI$40000000\r
+\r
+// file handle\r
+#REPLACE INVALID_HANDLE_VALUE |CI-00000001\r
+\r
+// dwFlags Constants\r
+#REPLACE WC_NO_BEST_FIT_CHARS |CI$00000400\r
+#REPLACE WC_COMPOSITECHECK |CI$00000200\r
+#REPLACE WC_DISCARDNS |CI$00000010\r
+#REPLACE WC_SEPCHARS |CI$00000020\r
+#REPLACE WC_DEFAULTCHAR |CI$00000040\r
+#REPLACE WC_ERR_INVALID_CHARS |CI$00000080 // Vista onwards only\r
+\r
+// Codepage Constants\r
+#REPLACE CP_ACP |CI0\r
+#REPLACE CP_OEMCP |CI1\r
+#REPLACE CP_MACCP |CI2\r
+#REPLACE CP_UTF7 |CI65000\r
+#REPLACE CP_UTF8 |CI65001\r
+\r
+// Running Process Constants\r
+#REPLACE PROCESS_QUERY_INFORMATION_X |CI$00001024\r
+#REPLACE PROCESS_QUERY_INFORMATION |CI$00000400\r
+#REPLACE PROCESS_VM_READ_X |CI$00000016\r
+#REPLACE PROCESS_VM_READ |CI$00000010\r
+#REPLACE STANDARD_RIGHTS_REQUIRED |CI$FFFF0000\r
+\r
+\r
+// GUID Constants\r
+#REPLACE GUID_STRING_LENGTH |CI$00000050 // GUID Length\r
+\r
+// FormatMessage\r
+#REPLACE FORMAT_MESSAGE_ALLOCATE_BUFFER |CI$00000100\r
+#REPLACE FORMAT_MESSAGE_FROM_SYSTEM |CI$00001000\r
+#REPLACE LANG_NEUTRAL |CI$00000000\r
+#REPLACE SUBLANG_DEFAULT |CI$00000001\r
+#REPLACE ERROR_BAD_USERNAME |CI$00002202\r
+\r
+// InternetCanonicalizeUrl\r
+#REPLACE ICU_NO_ENCODE |CI$20000000 // Don't convert unsafe characters to escape sequence\r
+#REPLACE ICU_DECODE |CI$10000000 // Convert %XX escape sequences to characters\r
+#REPLACE ICU_NO_META |CI$08000000 // Don't convert .. etc. meta path sequences\r
+#REPLACE ICU_ENCODE_SPACES_ONLY |CI$04000000 // Encode spaces only\r
+#REPLACE ICU_BROWSER_MODE |CI$02000000 // Special encode/decode rules for browser\r
+\r
+// advapi32 Crypt* constants\r
+#REPLACE PROV_RSA_FULL |CI00000001\r
+#REPLACE PROV_RSA_SIG |CI00000002\r
+#REPLACE PROV_DSS |CI00000003\r
+#REPLACE PROV_FORTEZZA |CI00000004\r
+#REPLACE PROV_MS_EXCHANGE |CI00000005\r
+#REPLACE PROV_SSL |CI00000006\r
+#REPLACE PROV_RSA_SCHANNEL |CI00000012\r
+#REPLACE PROV_DSS_DH |CI00000013\r
+#REPLACE PROV_EC_ECDSA_SIG |CI00000014\r
+#REPLACE PROV_EC_ECNRA_SIG |CI00000015\r
+#REPLACE PROV_EC_ECDSA_FULL |CI00000016\r
+#REPLACE PROV_EC_ECNRA_FULL |CI00000017\r
+#REPLACE PROV_DH_SCHANNEL |CI00000018\r
+#REPLACE PROV_SPYRUS_LYNKS |CI00000020\r
+#REPLACE PROV_RNG |CI00000021\r
+#REPLACE PROV_INTEL_SEC |CI00000022\r
+#REPLACE PROV_REPLACE_OWF |CI00000023\r
+#REPLACE PROV_RSA_AES |CI00000024\r
+\r
+#REPLACE CRYPT_VERIFYCONTEXT |CI00000000 // Supposedly |CI$F0000000\r
+#REPLACE CRYPT_NEWKEYSET |CI00000008\r
+#REPLACE CRYPT_DELETEKEYSET |CI00000016\r
+#REPLACE CRYPT_MACHINE_KEYSET |CI00000032\r
+#REPLACE CRYPT_SILENT |CI00000064\r
+#REPLACE CRYPT_EXPORTABLE |CI00000001\r
+#REPLACE CRYPT_USER_PROTECTED |CI00000002\r
+#REPLACE CRYPT_CREATE_SALT |CI00000004\r
+#REPLACE CRYPT_UPDATE_KEY |CI00000008\r
+\r
+#REPLACE CALG_3DES |CI$00006603 // Triple DES encryption algorithm.\r
+#REPLACE CALG_3DES_112 |CI$00006609 // Two-key triple DES encryption with effective key length equal to 112 bits.\r
+#REPLACE CALG_AES |CI$00006611 // Advanced Encryption Standard (AES). This algorithm is supported by the Microsoft AES Cryptographic Provider.\r
+#REPLACE CALG_AES_128 |CI$0000660E // 128 bit AES. This algorithm is supported by the Microsoft AES Cryptographic Provider.\r
+#REPLACE CALG_AES_192 |CI$0000660F // 192 bit AES. This algorithm is supported by the Microsoft AES Cryptographic Provider.\r
+#REPLACE CALG_AES_256 |CI$00006610 // 256 bit AES. This algorithm is supported by the Microsoft AES Cryptographic Provider.\r
+#REPLACE CALG_AGREEDKEY_ANY |CI$0000AA03 // Temporary algorithm identifier for handles of Diffie-Hellman-agreed keys.\r
+#REPLACE CALG_CYLINK_MEK |CI$0000660C // An algorithm to create a 40-bit DES key that has parity bits and zeroed key bits to make its key length 64 bits. This algorithm is supported by the Microsoft Base Cryptographic Provider.\r
+#REPLACE CALG_DES |CI$00006601 // DES encryption algorithm.\r
+#REPLACE CALG_DESX |CI$00006604 // DESX encryption algorithm.\r
+#REPLACE CALG_DH_EPHEM |CI$0000AA02 // Diffie-Hellman ephemeral key exchange algorithm.\r
+#REPLACE CALG_DH_SF |CI$0000AA01 // Diffie-Hellman store and forward key exchange algorithm.\r
+#REPLACE CALG_DSS_SIGN |CI$00002200 // DSA public key signature algorithm.\r
+#REPLACE CALG_ECDH |CI$0000AA05 // Elliptic curve Diffie-Hellman key exchange algorithm.\r
+#REPLACE CALG_ECDSA |CI$00002203 // Elliptic curve digital signature algorithm.\r
+#REPLACE CALG_ECMQV |CI$0000A001 // Elliptic curve Menezes, Qu, and Vanstone (MQV) key exchange algorithm. This algorithm is not supported.\r
+#REPLACE CALG_HASH_REPLACE_OWF |CI$0000800B // One way function hashing algorithm.\r
+#REPLACE CALG_HUGHES_MD5 |CI$0000A003 // Hughes MD5 hashing algorithm.\r
+#REPLACE CALG_HMAC |CI$00008009 // HMAC keyed hash algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.\r
+#REPLACE CALG_KEA_KEYX |CI$0000AA04 // KEA key exchange algorithm (FORTEZZA). This algorithm is not supported.\r
+#REPLACE CALG_MAC |CI$00008005 // MAC keyed hash algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.\r
+#REPLACE CALG_MD2 |CI$00008001 // MD2 hashing algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.\r
+#REPLACE CALG_MD4 |CI$00008002 // MD4 hashing algorithm.\r
+#REPLACE CALG_MD5 |CI$00008003 // MD5 hashing algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.\r
+#REPLACE CALG_NO_SIGN |CI$00002000 // No signature algorithm.\r
+#REPLACE CALG_OID_INFO_CNG_ONLY |CI$FFFFFFFF // The algorithm is only implemented in CNG. The macro, IS_SPECIAL_OID_INFO_ALGID, can be used to determine whether a cryptography algorithm is only supported by using the CNG functions.\r
+#REPLACE CALG_OID_INFO_PARAMETERS |CI$FFFFFFFE // The algorithm is defined in the encoded parameters. The algorithm is only supported by using CNG. The macro, IS_SPECIAL_OID_INFO_ALGID, can be used to determine whether a cryptography algorithm is only supported by using the CNG functions.\r
+#REPLACE CALG_PCT1_MASTER |CI$00004C04 // Used by the Schannel.dll operations system. This ALG_ID should not be used by applications.\r
+#REPLACE CALG_RC2 |CI$00006602 // RC2 block encryption algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.\r
+#REPLACE CALG_RC4 |CI$00006801 // RC4 stream encryption algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.\r
+#REPLACE CALG_RC5 |CI$0000660D // RC5 block encryption algorithm.\r
+#REPLACE CALG_RSA_KEYX |CI$0000A400 // RSA public key exchange algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.\r
+#REPLACE CALG_RSA_SIGN |CI$00002400 // RSA public key signature algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.\r
+#REPLACE CALG_SCHANNEL_ENC_KEY |CI$00004C07 // Used by the Schannel.dll operations system. This ALG_ID should not be used by applications.\r
+#REPLACE CALG_SCHANNEL_MAC_KEY |CI$00004C03 // Used by the Schannel.dll operations system. This ALG_ID should not be used by applications.\r
+#REPLACE CALG_SCHANNEL_MASTER_HASH |CI$00004C02 // Used by the Schannel.dll operations system. This ALG_ID should not be used by applications.\r
+#REPLACE CALG_SEAL |CI$00006802 // SEAL encryption algorithm. This algorithm is not supported.\r
+#REPLACE CALG_SHA |CI$00008004 // SHA hashing algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.\r
+#REPLACE CALG_SHA1 |CI$00008004 // Same as CALG_SHA. This algorithm is supported by the Microsoft Base Cryptographic Provider.\r
+#REPLACE CALG_SHA_256 |CI$0000800C // 256 bit SHA hashing algorithm. This algorithm is supported by Microsoft Enhanced RSA and AES Cryptographic Provider..\r
+#REPLACE CALG_SHA_384 |CI$0000800D // 384 bit SHA hashing algorithm. This algorithm is supported by Microsoft Enhanced RSA and AES Cryptographic Provider.\r
+#REPLACE CALG_SHA_512 |CI$0000800E // 512 bit SHA hashing algorithm. This algorithm is supported by Microsoft Enhanced RSA and AES Cryptographic Provider.\r
+#REPLACE CALG_SKIPJACK |CI$0000660A // Skipjack block encryption algorithm (FORTEZZA). This algorithm is not supported.\r
+#REPLACE CALG_SSL2_MASTER |CI$00004C05 // Used by the Schannel.dll operations system. This ALG_ID should not be used by applications.\r
+#REPLACE CALG_SSL3_MASTER |CI$00004C01 // Used by the Schannel.dll operations system. This ALG_ID should not be used by applications.\r
+#REPLACE CALG_SSL3_SHAMD5 |CI$00008008 // Used by the Schannel.dll operations system. This ALG_ID should not be used by applications.\r
+#REPLACE CALG_TEK |CI$0000660B // TEK (FORTEZZA). This algorithm is not supported.\r
+#REPLACE CALG_TLS1_MASTER |CI$00004C06 // Used by the Schannel.dll operations system. This ALG_ID should not be used by applications.\r
+#REPLACE CALG_TLS1PRF |CI$0000800A // Used by the Schannel.dll operations system. This ALG_ID should not be used by applications.\r
+\r
+#REPLACE HP_ALGID |CI00000001\r
+#REPLACE HP_HASHVAL |CI00000002\r
+#REPLACE HP_HASHSIZE |CI00000004\r
+\r
+#REPLACE MS_ENH_RSA_AES_PROV_XP "Microsoft Enhanced RSA and AES Cryptographic Provider (Prototype)"\r
+#REPLACE MS_ENH_RSA_AES_PROV "Microsoft Enhanced RSA and AES Cryptographic Provider"\r
+#REPLACE MS_DEF_PROV "Microsoft Base Cryptographic Provider v1.0"\r
+\r
+#REPLACE PP_ADMIN_PIN |CI$0000001F // Returns the administrator personal identification number (PIN) in the pbData parameter as a LPSTR.\r
+#REPLACE PP_CERTCHAIN |CI$00000009 // Returns the certificate chain associated with the hProv handle. The returned certificate chain is \r
+ // X509_ASN_ENCODING encoded.\r
+#REPLACE PP_CONTAINER |CI$00000006 // The name of the current key container as a null-terminated CHAR string. \r
+ // This string is exactly the same as the one passed in the pszContainer \r
+ // parameter of the CryptAcquireContext function to specify the key \r
+ // container to use. The pszContainer parameter can be read to determine \r
+ // the name of the default key container.\r
+#REPLACE PP_ENUMALGS |CI$00000001 // A PROV_ENUMALGS structure that contains information about one algorithm supported by the CSP being queried.\r
+#REPLACE PP_ENUMALGS_EX |CI$00000016 // A PROV_ENUMALGS_EX structure that contains information about one algorithm supported by the CSP being queried. \r
+ // The structure returned contains more information about the algorithm than the structure returned for PP_ENUMALGS.\r
+#REPLACE PP_ENUMCONTAINERS |CI$00000002 // The name of one of the key containers maintained by the CSP in the form of a null-terminated CHAR string. \r
+#REPLACE PP_ENUMEX_SIGNING_PROT |CI$00000028 // Indicates that the current CSP supports the dwProtocols member of the PROV_ENUMALGS_EX structure. \r
+ // If this function succeeds, the CSP supports the dwProtocols member of the PROV_ENUMALGS_EX structure. \r
+ // If this function fails with an NTE_BAD_TYPE error code, the CSP does not support the dwProtocols member.\r
+#REPLACE PP_IMPTYPE |CI$00000003 // A DWORD value that indicates how the CSP is implemented. For a table of possible values, see Remarks.\r
+#REPLACE PP_KEYEXCHANGE_PIN |CI$00000020 // Specifies that the key exchange PIN is contained in pbData. The PIN is represented as a null-terminated ASCII string.\r
+#REPLACE PP_KEYSET_SEC_DESCR |CI$00000008 // Retrieves the security descriptor for the key storage container. The pbData parameter is the address of a \r
+ // SECURITY_DESCRIPTOR structure that receives the security descriptor for the key storage container. \r
+ // The security descriptor is returned in self-relative format.\r
+#REPLACE PP_NAME |CI$00000004 // The name of the CSP in the form of a null-terminated CHAR string. This string is identical to the one passed in \r
+ // the pszProvider parameter of the CryptAcquireContext function to specify that the current CSP be used.\r
+\r
+// Encryption key formats\r
+#REPLACE PUBLICKEYBLOB |CI$00000006\r
+#REPLACE PRIVATEKEYBLOB |CI$00000007\r
+#REPLACE PLAINTEXTKEYBLOB |CI$00000008\r
+\r
+// Key params for advapi32 cryptography dwParam\r
+#REPLACE KP_IV |CI1 // Initialization vector\r
+#REPLACE KP_SALT |CI2 // Salt value\r
+#REPLACE KP_PADDING |CI3 // Padding values\r
+#REPLACE KP_MODE |CI4 // Mode of the cipher\r
+#REPLACE KP_MODE_BITS |CI5 // Number of bits to feedback\r
+#REPLACE KP_PERMISSIONS |CI6 // Key permissions DWORD\r
+#REPLACE KP_ALGID |CI7 // Key algorithm\r
+#REPLACE KP_BLOCKLEN |CI8 // Block size of the cipher\r
+#REPLACE KP_KEYLEN |CI9 // Length of key in bits\r
+#REPLACE KP_SALT_EX |CI10 // Length of salt in bytes\r
+#REPLACE KP_P |CI11 // DSS/Diffie-Hellman P value\r
+#REPLACE KP_G |CI12 // DSS/Diffie-Hellman G value\r
+#REPLACE KP_Q |CI13 // DSS Q value\r
+#REPLACE KP_X |CI14 // Diffie-Hellman X value\r
+#REPLACE KP_Y |CI15 // Y value\r
+#REPLACE KP_RA |CI16 // Fortezza RA value\r
+#REPLACE KP_RB |CI17 // Fortezza RB value\r
+#REPLACE KP_INFO |CI18 // For putting information into an RSA envelope\r
+#REPLACE KP_EFFECTIVE_KEYLEN |CI19 // Setting and getting RC2 effective key length\r
+#REPLACE KP_SCHANNEL_ALG |CI20 // for setting the Secure Channel algorithms\r
+#REPLACE KP_CLIENT_RANDOM |CI21 // for setting the Secure Channel client random data\r
+#REPLACE KP_SERVER_RANDOM |CI22 // for setting the Secure Channel server random data\r
+#REPLACE KP_RP |CI23\r
+#REPLACE KP_PRECOMP_MD5 |CI24\r
+#REPLACE KP_PRECOMP_SHA |CI25\r
+#REPLACE KP_CERTIFICATE |CI26 // for setting Secure Channel certificate data (PCT1)\r
+#REPLACE KP_CLEAR_KEY |CI27 // for setting Secure Channel clear key data (PCT1)\r
+#REPLACE KP_PUB_EX_LEN |CI28\r
+#REPLACE KP_PUB_EX_VAL |CI29\r
+#REPLACE KP_KEYVAL |CI30\r
+#REPLACE KP_ADMIN_PIN |CI31\r
+#REPLACE KP_KEYEXCHANGE_PIN |CI32\r
+#REPLACE KP_SIGNATURE_PIN |CI33\r
+#REPLACE KP_PREHASH |CI34 \r
+#REPLACE KP_OAEP_PARAMS |CI36 // for setting OAEP params on RSA keys\r
+#REPLACE KP_CMS_KEY_INFO |CI37\r
+#REPLACE KP_CMS_DH_KEY_INFO |CI38\r
+#REPLACE KP_PUB_PARAMS |CI39 // for setting public parameters\r
+#REPLACE KP_VERIFY_PARAMS |CI40 // for verifying DSA and DH parameters\r
+#REPLACE KP_HIGHEST_VERSION |CI41 // for TLS protocol version setting \r
+\r
+// Key params for advapi32 cryptography KP_PADDING\r
+#REPLACE PKCS5_PADDING |CI1 // PKCS 5 (sec 6.2) padding method\r
+#REPLACE RANDOM_PADDING |CI2\r
+#REPLACE ZERO_PADDING |CI3 \r
+\r
+// Key params for advapi32 cryptography KP_MODE\r
+#REPLACE CRYPT_MODE_CBC |CI1 // Cipher block chaining\r
+#REPLACE CRYPT_MODE_ECB |CI2 // Electronic code book\r
+#REPLACE CRYPT_MODE_OFB |CI3 // Output feedback mode\r
+#REPLACE CRYPT_MODE_CFB |CI4 // Cipher feedback mode\r
+#REPLACE CRYPT_MODE_CTS |CI5 // Ciphertext stealing mode \r
+\r
+// Params for crypt32 hashing\r
+#REPLACE CRYPT_STRING_BASE64 |CI$00000001\r
+#REPLACE CRYPT_STRING_HEX |CI$00000004\r
+#REPLACE CRYPT_STRING_HEXASCII |CI$00000005\r
+#REPLACE CRYPT_STRING_HEXADDR |CI$0000000A\r
+#REPLACE CRYPT_STRING_HEXASCIIADDR |CI$0000000B\r
+#REPLACE CRYPT_STRING_HEXRAW |CI$0000000C\r
+\r
+// Used by out GetTimeZoneInformation / GetSystemTime\r
+#REPLACE TIME_ZONE_ID_UNKNOWN |CI$00000000\r
+#REPLACE TIME_ZONE_ID_STANDARD |CI$00000001\r
+#REPLACE TIME_ZONE_ID_DAYLIGHT |CI$00000002\r
+#REPLACE TIME_ZONE_ID_INVALID |CI$FFFFFFFF\r
+\r
+//-------------------------------------------------------------------------\r
+// Structs\r
+//-------------------------------------------------------------------------\r
+\r
+// Used by convert_date_format to convert two dword values representing file mod time into string\r
+type _FILETIME\r
+ field FILETIME.dwLowDateTime as dword\r
+ field FILETIME.dwHighDateTime as dword\r
+end_type\r
+\r
+// Used by convert_date_format to convert two dword values representing system time into string\r
+type _SYSTEMTIME\r
+ field SYSTEMTIME.wYear as word\r
+ field SYSTEMTIME.wMonth as word\r
+ field SYSTEMTIME.wDayOfWeek as word\r
+ field SYSTEMTIME.wDay as word\r
+ field SYSTEMTIME.wHour as word\r
+ field SYSTEMTIME.wMinute as word\r
+ field SYSTEMTIME.wSecond as word\r
+ field SYSTEMTIME.wMilliseconds as word\r
+end_type\r
+\r
+type _SYSTEMTIME2\r
+ field SYSTEMTIME2.wYear as char 2\r
+ field SYSTEMTIME2.wMonth as char 2\r
+ field SYSTEMTIME2.wDayOfWeek as char 2\r
+ field SYSTEMTIME2.wDay as char 2\r
+ field SYSTEMTIME2.wHour as char 2\r
+ field SYSTEMTIME2.wMinute as char 2\r
+ field SYSTEMTIME2.wSecond as char 2\r
+ field SYSTEMTIME2.wMilliseconds as char 2\r
+end_type\r
+\r
+// Used by list_directory to read data out of string returned by kernel32\r
+type _WIN32_FIND_DATA\r
+ field WIN32_FIND_DATA.dwFileAttributes as dword\r
+ field WIN32_FIND_DATA.ftCreationLowDateTime as dword\r
+ field WIN32_FIND_DATA.ftCreationHighDateTime as dword\r
+ field WIN32_FIND_DATA.ftLastAccessLowDateTime as dword\r
+ field WIN32_FIND_DATA.ftLastAccessHighDateTime As dword\r
+ field WIN32_FIND_DATA.ftLastWriteLowDateTime as dword\r
+ field WIN32_FIND_DATA.ftLastWriteHighDateTime as dword\r
+ field WIN32_FIND_DATA.nFileSizeHigh as dword\r
+ field WIN32_FIND_DATA.nFileSizeLow as dword\r
+ field WIN32_FIND_DATA.dwReserved0 as dword\r
+ field WIN32_FIND_DATA.dwReserved1 as dword\r
+ field WIN32_FIND_DATA.cFileName as char 260\r
+ field WIN32_FIND_DATA.cAlternateFileName as char 14\r
+end_type\r
+// used by fileopp to pass details into SHFileOperation\r
+type _SHFILEOPSTRUCT\r
+ field SHFileOpStruct.hWnd as dword // Handle of dialog box to display status info - think this is for vb c# etc\r
+ field SHFileOpStruct.wFunc as dword // Operation to perform\r
+ field SHFileOpStruct.pFrom as pointer // char // A string specifying one or more source file names. Multiple names must be null-separated. The list of names must be double null-terminated\r
+ field SHFileOpStruct.pTo as pointer // char // Same as pFrom except for the destination\r
+ field SHFileOpStruct.fFlags as integer // Flags that control the file operation\r
+ field SHFileOpStruct.fAnyOperationsAborted as dword // TRUE if an operation was aborted before it was completed\r
+ field SHFileOpStruct.hNameMappings as dword // Only used with certain flags\r
+ field SHFileOpStruct.lpszProgressTitle as dword // Title for a progress dialog box\r
+end_type\r
+\r
+// Used by getComputerName to read computer name out into\r
+type _SIZEGETCOMPUTERNAME\r
+ field SIZEGETCOMPUTERNAME.dwSize as dWord\r
+end_type\r
+\r
+// Used by folderbrowse to send parameters to and read data out from SHBrowseFolder\r
+type _BROWSEINFO\r
+ field BROWSEINFO.hWndOwner as handle\r
+ field BROWSEINFO.pIDLRoot as pointer\r
+ field BROWSEINFO.pszDisplayName as pointer\r
+ field BROWSEINFO.lpszTitle as pointer\r
+ field BROWSEINFO.ulFlags as dword\r
+ field BROWSEINFO.lpfnCallback as pointer\r
+ field BROWSEINFO.lParam as dword\r
+ field BROWSEINFO.iImage as dword\r
+end_type\r
+// Used by create_proc to read created process details out of kernel32\r
+type _PROCESS_INFORMATION\r
+ field PROCESS_INFORMATION.hProcess as handle\r
+ field PROCESS_INFORMATION.hThread as handle\r
+ field PROCESS_INFORMATION.dwProcessId as dword\r
+ field PROCESS_INFORMATION.dwThreadId as dword\r
+end_type\r
+// Used by create_proc to read create process details into of kernel32\r
+type _STARTUPINFO\r
+ field STARTUPINFO.cb as integer\r
+ field STARTUPINFO.lpReserved as pointer // to string\r
+ field STARTUPINFO.lpDesktop as pointer // to string\r
+ field STARTUPINFO.lpTitle as pointer // to string\r
+ field STARTUPINFO.dwX as dword\r
+ field STARTUPINFO.dwY as dword\r
+ field STARTUPINFO.dwXSize as dword\r
+ field STARTUPINFO.dwYSize as dword\r
+ field STARTUPINFO.dwXCountChars as dword\r
+ field STARTUPINFO.dwYCountChars as dword\r
+ field STARTUPINFO.dwFillAttribute as dword\r
+ field STARTUPINFO.dwFlags as dword\r
+ field STARTUPINFO.wShowWindow as integer\r
+ field STARTUPINFO.cbReserved2 as integer\r
+ field STARTUPINFO.lpReserved2 as pointer\r
+ field STARTUPINFO.hStdInput as handle\r
+ field STARTUPINFO.hStdOutput as handle\r
+ field STARTUPINFO.hStdError as handle\r
+end_type\r
+// Used to receive an array from get_procs\r
+type _PROCESSARRAY\r
+ field PROCESSARRAY.arrayItem as dword\r
+end_type\r
+\r
+// Used by ReadFile\r
+type _STRUCTBYTESREAD\r
+ field STRUCTBYTESREAD.integer0 as dword\r
+end_type\r
+// Used by get_procs\r
+type _STRUCTBYTESBACK\r
+ field STRUCTBYTESBACK.integer0 as dword\r
+end_type\r
+\r
+// Used by create_guid (http:// msdn.microsoft.com/en-us/library/aa373931(VS.85).aspx)\r
+type _GUID\r
+ field GUID.data1 as dword\r
+ field GUID.data2 as word\r
+ field GUID.data3 as word\r
+ field GUID.data4 as char 8\r
+end_type\r
+\r
+type _DISKDATA1\r
+ field DISKDATA1.sectorsPerCluster as dword\r
+end_type\r
+type _DISKDATA2\r
+ field DISKDATA2.bytesPerSector as dword\r
+end_type\r
+type _DISKDATA3\r
+ field DISKDATA3.numberOfFreeClusters as dword\r
+end_type\r
+type _DISKDATA4\r
+ field DISKDATA4.totalNumberOfClusters as dword\r
+end_type\r
+\r
+// Used by GetProcessMemoryInfo\r
+type _PROCESS_MEMORY_COUNTERS\r
+ field PROCESS_MEMORY_COUNTERS.cb as dword // The size of the structure, in bytes.\r
+ field PROCESS_MEMORY_COUNTERS.PageFaultCount as dword // The number of page faults.\r
+ field PROCESS_MEMORY_COUNTERS.PeakWorkingSetSize as dword // The peak working set size, in bytes.\r
+ field PROCESS_MEMORY_COUNTERS.WorkingSetSize as dword // The current working set size, in bytes.\r
+ field PROCESS_MEMORY_COUNTERS.QuotaPeakPagedPoolUsage as dword // The peak paged pool usage, in bytes.\r
+ field PROCESS_MEMORY_COUNTERS.QuotaPagedPoolUsage as dword // The current paged pool usage, in bytes.\r
+ field PROCESS_MEMORY_COUNTERS.QuotaPeakNonPagedPoolUsage as dword // The peak nonpaged pool usage, in bytes.\r
+ field PROCESS_MEMORY_COUNTERS.QuotaNonPagedPoolUsage as dword // The current nonpaged pool usage, in bytes.\r
+ field PROCESS_MEMORY_COUNTERS.PagefileUsage as dword // The current space allocated for the pagefile, in bytes. Those pages may or may not be in memory.\r
+ field PROCESS_MEMORY_COUNTERS.PeakPagefileUsage as dword // The peak space allocated for the pagefile, in bytes.\r
+end_type\r
+\r
+// Used by hashing algorithms based on advapi32\r
+type _HCRYPTHASH\r
+ field HCRYPTHASH.value as dword\r
+end_type\r
+\r
+// Used by encryption algorithms based on advapi32\r
+type _HCRYPTKEY\r
+ field HCRYPTKEY.value as dword\r
+end_type\r
+\r
+// Used by encryption algorithms to import / export keys\r
+type _PLAINTEXTKEYBLOB \r
+ field PLAINTEXTKEYBLOB.BLOBHEADER AS char 8 //64 bit\r
+ field PLAINTEXTKEYBLOB.dwKeySize AS dword\r
+ field PLAINTEXTKEYBLOB.rgbKeyData AS char 512\r
+end_type\r
+\r
+// Used by encryption algorithms to import / export keys\r
+type _BLOBHEADER\r
+ field BLOBHEADER.bType AS byte\r
+ field BLOBHEADER.bVersion AS byte\r
+ field BLOBHEADER.Reserved AS word\r
+ field BLOBHEADER.ALG_ID AS byte //UInt\r
+end_type\r
+\r
+// Used for numeric (int,dword,ptr etc) address referencing\r
+type _DW_TYPE\r
+ field DW_TYPE.value as dword\r
+end_type\r
+\r
+// Used by GetVersionEx\r
+type _OSVERSIONINFO\r
+ field OSVERSIONINFO.dwOSVersionInfoSize as dword\r
+ field OSVERSIONINFO.dwMajorVersion as dword\r
+ field OSVERSIONINFO.dwMinorVersion as dword\r
+ field OSVERSIONINFO.dwBuildNumber as dword\r
+ field OSVERSIONINFO.dwPlatformId as dword\r
+ field OSVERSIONINFO.szCSDVersion as char 128\r
+end_type\r
+\r
+// TimeZoneInfo\r
+type _TIME_ZONE_INFORMATION\r
+ field TIME_ZONE_INFORMATION.Bias as dword // long\r
+ field TIME_ZONE_INFORMATION.StandardName as char 64 // wchar array\r
+ field TIME_ZONE_INFORMATION.StandardDate as char 16 // SYSTEMTIME (structure but not actually SYSTEMTIME)\r
+ field TIME_ZONE_INFORMATION.StandardBias as dword // long\r
+ field TIME_ZONE_INFORMATION.DaylightName as char 64 // wchar array (structure but not actually SYSTEMTIME)\r
+ field TIME_ZONE_INFORMATION.DaylightDate as char 16 // SYSTEMTIME\r
+ field TIME_ZONE_INFORMATION.DaylightBias as dword // long\r
+end_type\r
+\r
+//-------------------------------------------------------------------------\r
+// Global arrays used to store results from legacy functions\r
+//------------------------------------------------------------------------- \r
+\r
+// Global arrays for temporary use by win32 functions\r
+object Win32API_result1 is an array \r
+end_object\r
+object Win32API_result2 is an array\r
+end_object\r
+object Win32API_result3 is an array\r
+end_object\r
+object Win32API_result4 is an array\r
+end_object\r
+object Win32API_result5 is an array\r
+end_object\r
+\r
+// Used for buffering text files via win32\r
+object Win32API_buffer is an array\r
+end_object\r
+\r
+// Used by list_directory for sorting\r
+object Win32API_sort is an array\r
+end_object\r
+object Win32API_sort1 is an array\r
+end_object\r
+object Win32API_sort2 is an array\r
+end_object\r
+object Win32API_sort3 is an array\r
+end_object\r
+object Win32API_sort4 is an array\r
+end_object\r
+object Win32API_sort5 is an array\r
+end_object\r
+object Win32API_sort6 is an array\r
+end_object\r
+\r
+//-------------------------------------------------------------------------\r
+// Global variables\r
+//-------------------------------------------------------------------------\r
+integer g_sConsoleTitleIsSet\r
+move "" to g_sConsoleTitleIsSet\r
--- /dev/null
+//-------------------------------------------------------------------------\r
+// win32.inc\r
+// This file contains DataFlex functions to provide wrappers around "Win32"\r
+// API calls. See win32.h for external function definitions.\r
+//\r
+// This file is to be included when using Win32 capabilities in df32func.mk\r
+//\r
+// Copyright (c) 2006-2009, glyn@8kb.co.uk\r
+// \r
+// df32func/win32.inc\r
+//-------------------------------------------------------------------------\r
+\r
+#IFDEF __win32_h__\r
+#ELSE\r
+ #INCLUDE win32.h\r
+#ENDIF\r
+\r
+//-------------------------------------------------------------------------\r
+// Functions\r
+//-------------------------------------------------------------------------\r
+\r
+// Takes both the high-order doubleword and low-order doubleword representing the date&time 2X32bit numbers\r
+// and returns as a string\r
+function convert_date_format global dword dwLowDateTime dword dwHighDateTime returns string\r
+ local string sftTime sSystemTime sFormattedTime sFormattedDate sLocalFileTime\r
+ local pointer lpsftTime lpsSystemTime lpsFormattedTime lpsFormattedDate lpsLocalFileTime\r
+ local integer iSuccess iLenCcTime iDataLength iLenCcDate\r
+\r
+ zerotype _FILETIME to sftTime\r
+ put dwLowDateTime to sftTime at FILETIME.dwLowDateTime\r
+ put dwHighDateTime to sftTime at FILETIME.dwHighDateTime\r
+ getaddress of sftTime to lpsftTime\r
+\r
+ zeroType _FILETIME to sLocalFileTime\r
+ getaddress of sLocalFileTime to lpsLocalFileTime\r
+\r
+ move (FileTimeToLocalFileTime(lpsftTime,lpsLocalFileTime)) to iSuccess\r
+ if (iSuccess <> 0) begin\r
+ zerotype _SYSTEMTIME to sSystemTime\r
+ getaddress of sSystemTime to lpsSystemTime\r
+\r
+ move (FileTimeToSystemTime(lpsLocalFileTime,lpsSystemTime)) to iSuccess\r
+ if (iSuccess <> 0) begin\r
+ zerostring 255 to sFormattedTime\r
+ getaddress of sFormattedTime to lpsFormattedTime\r
+ move (length(sFormattedTime)) to iLenCcTime\r
+ move (GetTimeFormat("LOCALE_USER_DEFAULT", 0, lpsSystemTime, 0, lpsFormattedTime, iLenCcTime)) to iDataLength\r
+ \r
+ zerostring 255 To sFormattedDate\r
+ getaddress of sFormattedDate To lpsFormattedDate\r
+ move (length(sFormattedDate)) to iLenCcDate\r
+ move (GetDateFormat("LOCALE_USER_DEFAULT", 0, lpsSystemTime, 0, lpsFormattedDate, iLenCcDate)) to iDataLength\r
+ function_return (cstring (sFormattedDate) * cstring (sFormattedTime)) // return with terminating null char removed\r
+ end\r
+ end\r
+end_function\r
+\r
+// List directory takes a directory path and returns a file count-1\r
+// file listing information including size is put into 5 global arrays\r
+//\r
+// Returns an integer file_count-1, where count represents the number of files found in the directory.\r
+// I.e. If no files are found it will return -1, if one file is found it will return 0\r
+// If files are found, attributes of the files can be found in the following global arrays:\r
+// \r
+// Win32API_result1 - File Name\r
+// Win32API_result2 - File Size\r
+// Win32API_result3 - Modified Date\r
+// Win32API_result4 - Access Date\r
+// Win32API_result5 - Creation Date\r
+// \r
+function list_directory global string argv returns string\r
+ local string sPathName sWin32FindData sLine sLast sComment sFileName sModifiedDate sAccessDate sCreationDate k sLastFile\r
+ local integer l_01iResult iFileSize iFileCount\r
+ local pointer pT5 pT6\r
+ local handle hFile\r
+ local dword dwFileSizeHigh dwFileSizeLow dwHighDateTime dwLowDateTime\r
+\r
+ send delete_data to Win32API_result1\r
+ send delete_data to Win32API_result2\r
+ send delete_data to Win32API_result3\r
+ send delete_data to Win32API_result4\r
+ send delete_data to Win32API_result5\r
+\r
+ zerotype _WIN32_FIND_DATA to sWin32FindData\r
+ getaddress of sWin32FindData to pT5\r
+ move argv to sPathName\r
+ getaddress of sPathName to pT6\r
+ move (FindFirstFile(pT6, pT5)) to hFile\r
+ // if (hFile = -1) showln "Invalid file handle!"\r
+\r
+ move -1 to iFileCount\r
+ repeat \r
+ // FileName\r
+ getbuff_String from sWin32FindData at WIN32_FIND_DATA.cFileName to sFileName\r
+ if ((sFileName <> ".") and (sFileName <> "..") and (sFileName <> "")) begin\r
+ increment iFileCount\r
+\r
+ // FileSize\r
+ getbuff from sWin32FindData at WIN32_FIND_DATA.nFileSizeHigh to dwFileSizeHigh\r
+ getbuff from sWin32FindData at WIN32_FIND_DATA.nFileSizeLow to dwFileSizeLow\r
+ moveint ((dwFileSizeHigh*MaxDword)+dwFileSizeLow) to iFileSize\r
+\r
+ // File Modified Time\r
+ getbuff from sWin32FindData at WIN32_FIND_DATA.ftLastWriteLowDateTime to dwLowDateTime\r
+ getbuff from sWin32FindData at WIN32_FIND_DATA.ftLastWriteHighDateTime to dwHighDateTime\r
+ move (convert_date_format(dwLowDateTime, dwHighDateTime)) to sModifiedDate\r
+ \r
+ // File Accessed Time\r
+ getbuff from sWin32FindData at WIN32_FIND_DATA.ftLastAccessLowDateTime to dwLowDateTime\r
+ getbuff from sWin32FindData at WIN32_FIND_DATA.ftLastAccessHighDateTime to dwHighDateTime\r
+ move (convert_date_format(dwLowDateTime, dwHighDateTime)) to sAccessDate\r
+ \r
+ // File Creation Time\r
+ getbuff from sWin32FindData at WIN32_FIND_DATA.ftCreationLowDateTime to dwLowDateTime\r
+ getbuff from sWin32FindData at WIN32_FIND_DATA.ftCreationHighDateTime to dwHighDateTime\r
+ move (convert_date_format(dwLowDateTime, dwHighDateTime)) to sCreationDate\r
+\r
+ set array_value of (Win32API_result1(current_object)) item iFileCount to sFileName\r
+ set array_value of (Win32API_result2(current_object)) item iFileCount to iFileSize\r
+ set array_value of (Win32API_result3(current_object)) item iFileCount to sModifiedDate\r
+ set array_value of (Win32API_result4(current_object)) item iFileCount to sAccessDate\r
+ set array_value of (Win32API_result5(current_object)) item iFileCount to sCreationDate\r
+ end\r
+ zerotype _WIN32_FIND_DATA to sWin32FindData\r
+ move (FindNextFile(hFile, pT5)) to l_01iResult\r
+ until (l_01iResult = 0)\r
+ move (FindClose(hFile)) to l_01iResult\r
+\r
+ function_return iFileCount\r
+end_function\r
+\r
+// Sort a directory listing\r
+// argv = array to sort by 1-6, argv2 = array size\r
+// Returns the the data array size\r
+function sort_results global integer argv integer argv2 returns integer\r
+ local integer doneSort l_i l_j l_h l_tmpInt\r
+ local number l_tmpNum\r
+ local string l_tmpStr l_tmpStr2\r
+ local date l_tmpDate\r
+ \r
+ send delete_data to Win32API_sort\r
+ send delete_data to Win32API_sort1\r
+ send delete_data to Win32API_sort2\r
+ send delete_data to Win32API_sort3\r
+ send delete_data to Win32API_sort4\r
+ send delete_data to Win32API_sort5\r
+ send delete_data to Win32API_sort6\r
+\r
+ move 0 to doneSort\r
+ if ((argv < 1) or (argv > 5)) goto sorted\r
+\r
+ for l_i from 0 to argv2\r
+ if (argv = 1) get string_value of (Win32API_result1(current_object)) item l_i to l_tmpStr\r
+ if (argv = 2) get integer_value of (Win32API_result2(current_object)) item l_i to l_tmpInt\r
+ if (argv = 3) get string_value of (Win32API_result3(current_object)) item l_i to l_tmpStr\r
+ if (argv = 4) get string_value of (Win32API_result4(current_object)) item l_i to l_tmpStr\r
+ if (argv = 5) get string_value of (Win32API_result5(current_object)) item l_i to l_tmpStr\r
+\r
+ if (argv = 1) begin\r
+ if ((trim(l_tmpStr)) = "") move "NULL" to l_tmpStr\r
+ set array_value of (Win32API_sort(current_object)) item l_i to (string(lowercase(l_tmpStr)))\r
+ end\r
+ if (argv = 2) set array_value of (Win32API_sort(current_object)) item l_i to l_tmpInt\r
+ if (argv > 2) begin\r
+ calc ((((((integer(mid(l_tmpStr,2,12)))*60)+(integer(mid(l_tmpStr,2,15))))+(((date(mid(l_tmpStr,10,1)))-693975)*1440))*60)+(integer(mid(l_tmpStr,2,18)))) to l_tmpNum\r
+ set array_value of (Win32API_sort(current_object)) item l_i to l_tmpNum\r
+ set array_value of (Win32API_sort6(current_object)) item l_i to l_tmpNum\r
+ end\r
+ loop\r
+\r
+ send sort_items to Win32API_sort ascending\r
+\r
+ for l_i from 0 to argv2\r
+ get string_value of (Win32API_sort(current_object)) item l_i to l_tmpStr\r
+ if ((trim(uppercase(l_tmpStr))) <> "NULL") begin\r
+ for l_j from 0 to argv2\r
+ if (argv = 1) get string_value of (Win32API_result1(current_object)) item l_j to l_tmpStr2\r
+ if (argv = 2) get string_value of (Win32API_result2(current_object)) item l_j to l_tmpStr2\r
+ if (argv > 2) get string_value of (Win32API_sort6(current_object)) item l_j to l_tmpStr2\r
+\r
+ if (((trim(l_tmpStr2)) <> "NULL") and ((trim(l_tmpStr2)) <> "")) begin\r
+ if ((trim(lowercase(l_tmpStr))) = (trim(lowercase(l_tmpStr2)))) begin\r
+ get string_value of (Win32API_result1(current_object)) item l_j to l_tmpStr\r
+ set array_value of (Win32API_sort1(current_object)) item l_i to l_tmpStr\r
+ get integer_value of (Win32API_result2(current_object)) item l_j to l_tmpInt\r
+ set array_value of (Win32API_sort2(current_object)) item l_i to l_tmpInt\r
+ get string_value of (Win32API_result3(current_object)) item l_j to l_tmpStr\r
+ set array_value of (Win32API_sort3(current_object)) item l_i to l_tmpStr\r
+ get string_value of (Win32API_result4(current_object)) item l_j to l_tmpStr\r
+ set array_value of (Win32API_sort4(current_object)) item l_i to l_tmpStr\r
+ get string_value of (Win32API_result5(current_object)) item l_j to l_tmpStr\r
+ set array_value of (Win32API_sort5(current_object)) item l_i to l_tmpStr\r
+\r
+ if (argv = 1) set array_value of (Win32API_result1(current_object)) item l_j to "NULL"\r
+ if (argv = 2) set array_value of (Win32API_result2(current_object)) item l_j to "NULL"\r
+ if (argv > 2) set array_value of (Win32API_sort6(current_object)) item l_j to "NULL"\r
+\r
+ move argv2 to l_j\r
+ end\r
+ end\r
+ loop\r
+ end\r
+ loop\r
+ for l_i from 0 to argv2\r
+ get string_value of (Win32API_sort1(current_object)) item l_i to l_tmpStr\r
+ set array_value of (Win32API_result1(current_object)) item l_i to l_tmpStr\r
+ get string_value of (Win32API_sort2(current_object)) item l_i to l_tmpInt\r
+ set array_value of (Win32API_result2(current_object)) item l_i to l_tmpInt\r
+ get string_value of (Win32API_sort3(current_object)) item l_i to l_tmpStr\r
+ set array_value of (Win32API_result3(current_object)) item l_i to l_tmpStr\r
+ get string_value of (Win32API_sort4(current_object)) item l_i to l_tmpStr\r
+ set array_value of (Win32API_result4(current_object)) item l_i to l_tmpStr\r
+ get string_value of (Win32API_sort5(current_object)) item l_i to l_tmpStr\r
+ set array_value of (Win32API_result5(current_object)) item l_i to l_tmpStr\r
+ loop\r
+\r
+ send delete_data to Win32API_sort\r
+ send delete_data to Win32API_sort1\r
+ send delete_data to Win32API_sort2\r
+ send delete_data to Win32API_sort3\r
+ send delete_data to Win32API_sort4\r
+ send delete_data to Win32API_sort5\r
+\r
+ sorted:\r
+ function_return doneSort\r
+end_function\r
+\r
+// This function allows basic file operations delete, move, copy, rename\r
+// Useful where DataFlex internal functionssuch as erasefile or copyfile are flakey.\r
+// \r
+// fileOpp(<operation type>,<source file>,<dest file>)\r
+// <operation name> can be any of "COPY", "DELETE", "MOVE" or "RENAME"\r
+//\r
+// Example usage:\r
+//\r
+// fileOpp("delete","C:\FileTo.delete","")\r
+// fileOpp("move","C:\Source.file","C:\Destination.file")\r
+//\r
+function fileopp global string argv string argv2 string argv3 returns integer\r
+ local string sFileOp\r
+ local pointer lpFileOp lpArgv2 lpArgv3\r
+ local integer l_iResult\r
+\r
+ move 0 to l_iResult\r
+ move (trim(uppercase(argv))) to argv\r
+ move (trim(argv2)) to argv2\r
+ move (trim(argv3)) to argv3\r
+\r
+ if (((argv = "COPY") or (argv = "PRINT") or (argv = "DELETE") or (argv = "MOVE") or (argv = "RENAME")) and (argv2 <> "")) begin\r
+ zerotype _SHFILEOPSTRUCT to sFileOp\r
+ getaddress of sFileOp to lpFileOp\r
+\r
+ case begin\r
+ case (argv = "COPY") put FO_COPY to sFileOp at SHFILEOPSTRUCT.wFunc\r
+ case break\r
+ case (argv = "PRINT") put FO_COPY to sFileOp at SHFILEOPSTRUCT.wFunc\r
+ case break\r
+ case (argv = "DELETE") put FO_DELETE to sFileOp at SHFILEOPSTRUCT.wFunc\r
+ case break\r
+ case (argv = "MOVE") put FO_MOVE to sFileOp at SHFILEOPSTRUCT.wFunc\r
+ case break\r
+ case (argv = "RENAME") put FO_RENAME to sFileOp at SHFILEOPSTRUCT.wFunc\r
+ case break\r
+ case end\r
+\r
+ move (argv2+character(0)+character(0)) to argv2\r
+ move (argv3+character(0)+character(0)) to argv3\r
+ getAddress of argv2 to lpArgv2\r
+ put lpArgv2 to sFileOp at SHFILEOPSTRUCT.pFrom\r
+ \r
+ if (argv <> "DELETE") begin\r
+ getAddress Of argv3 to lpArgv3\r
+ put lpArgv3 to sFileOp at SHFILEOPSTRUCT.pTo\r
+ end \r
+\r
+ case begin\r
+ case (argv = "PRINT") put (FOF_NOCONFIRMATION+FOF_NOCONFIRMMKDIR+FOF_SILENT+FOF_NOERRORUI+FOF_NOCOPYSECURITYATTRIBS) to sFileOp at SHFILEOPSTRUCT.fFlags\r
+ case break\r
+ case else put (FOF_NOCONFIRMATION+FOF_NOCONFIRMMKDIR+FOF_SILENT+FOF_NOERRORUI) to sFileOp at SHFILEOPSTRUCT.fFlags\r
+ case break\r
+ case end\r
+ \r
+ // put ? to sFileOp at SHFILEOPSTRUCT.hWnd\r
+ // put ? to sFileOp at SHFILEOPSTRUCT.fAnyOperationsAborted\r
+ // put ? to sFileOp at SHFILEOPSTRUCT.hNameMappings\r
+ // put ? to sFileOp at SHFILEOPSTRUCT.lpszProgressTitle\r
+\r
+ move (SHFileOperation(lpFileOp)) to l_iResult\r
+ end\r
+\r
+ function_return l_iResult\r
+end_function\r
+\r
+// Get temp dir on local machine from windows registry\r
+function get_local_temp global integer argv returns string\r
+ local string lpBuffer\r
+ local integer l_01iResult\r
+ local pointer tmpPtr\r
+ \r
+ move (pad(lpBuffer,255)) to lpBuffer // this is a hack to allocate a specific size to a local string\r
+ getaddress of lpBuffer to tmpPtr\r
+ move (GetTempPath(255,tmpPtr)) to l_01iResult\r
+\r
+ function_return lpbuffer\r
+end_function\r
+\r
+// Get system dir on local machine from windows registry\r
+function get_local_system global integer argv returns string\r
+ local string sBuffer\r
+ local pointer lpBuffer l_iResult uSize\r
+\r
+ move 255 to uSize\r
+ move (repeat(character(0),(uSize+1))) to sBuffer \r
+ getAddress of sBuffer to lpBuffer\r
+ move (GetSystemDirectory(lpBuffer,uSize)) to l_iResult \r
+ \r
+ function_return (left(sBuffer,l_iResult))\r
+end_function\r
+\r
+// Function to open close cd tray dll - 0 to open 1 to close\r
+function cd_tray global integer argv returns integer\r
+ local integer l_iResult\r
+ local string l_sReturn l_sCmd \r
+ local pointer l_pCmd l_pReturn\r
+ \r
+ zerostring 127 to l_sCmd \r
+ getaddress of l_sCmd to l_pCmd\r
+ getaddress of l_sReturn to l_pReturn\r
+\r
+ if (argv = 0) move "set CDAudio door open" to l_sCmd\r
+ if (argv = 1) move "set CDAudio door closed" to l_sCmd\r
+ move (mciSendString(l_pCmd,l_pReturn,127,0)) to l_iResult\r
+ \r
+ function_return l_sReturn\r
+end_function\r
+\r
+// This function will force dataflex to exit with the error code in iReturnCode\r
+function exit_process global integer iReturnCode returns integer\r
+ local integer iVoid\r
+ \r
+ move (ExitProcessEx(iReturnCode)) To iVoid\r
+ \r
+ function_return iVoid\r
+end_function\r
+\r
+// Grab the process ID of dfruncon\r
+function get_process_id global integer argv returns integer\r
+ local integer iRVal\r
+ \r
+ move (GetPID()) TO iRVal\r
+ \r
+ function_return (Low(iRVal))\r
+end_function\r
+\r
+// Grab the computername\r
+function get_computer global integer argv returns string\r
+ local string strName lsSize\r
+ local pointer lpNameAddr lpSize\r
+ local integer l_01iResult\r
+\r
+ move (repeat(character(0),255)) to strName\r
+ getAddress of strName to lpNameAddr\r
+ move (repeat(character(0),_SIZEGETCOMPUTERNAME_SIZE)) to lsSize\r
+ put 16 to lsSize at SIZEGETCOMPUTERNAME.dwSize\r
+ getAddress of lsSize to lpSize\r
+ move (GetComputername(lpNameAddr, lpSize )) to l_01iResult\r
+ \r
+ if (l_01iResult) function_return (cstring(strName)) // return with terminating null char removed\r
+ else function_return "Unknown"\r
+end_function\r
+ \r
+// Grab the windows username\r
+function get_user_name global integer argv returns string\r
+ local string strName\r
+ local pointer lpNameAddr\r
+ local integer l_01iResult\r
+\r
+ move (repeat(character(0),255)) to strName\r
+ getAddress of strName to lpNameAddr\r
+ move (WNetGetUser(0, lpNameAddr, DWORDtoBytes(255))) to l_01iResult\r
+ if (l_01iResult = 0) function_return (uppercase(cstring(strName))) // return with terminating null char removed\r
+ else function_return "Unknown"\r
+end_function\r
+\r
+// Use a standard windows folder browser, takes the title of the browser, returns the file path\r
+function folder_browse global string argv returns String\r
+ local string sFolder sBrowseInfo sTitle\r
+ local pointer lpItemIdList lpsFolder lpsBrowseInfo lpsTitle\r
+ integer iFolderSelected l_iRetval\r
+\r
+ zeroType _BROWSEINFO to sBrowseInfo\r
+\r
+ if (argv<>"") begin\r
+ move argv to sTitle\r
+ getAddress of sTitle to lpsTitle\r
+ put lpsTitle to sBrowseInfo at BROWSEINFO.lpszTitle\r
+ end\r
+\r
+ put BIF_RETURNONLYFSDIRS+BIF_EDITBOX+BIF_BROWSEINCLUDEFILES to sBrowseInfo At BROWSEINFO.ulFlags\r
+ // put (window_handle(focus(desktop))) to sBrowseInfo At BROWSEINFO.hWndOwner ??\r
+ move (repeat(character(0),260)) to sFolder // set the size of sFolder to 128 by nulling in 8 chars\r
+ \r
+ getAddress Of sBrowseInfo to lpsBrowseInfo\r
+ getAddress Of sFolder to lpsFolder\r
+\r
+ move (SHBrowseForFolder(lpsBrowseInfo)) to lpItemIdList // select folder\r
+ move (SHGetPathFromIDList(lpItemIdList, lpsFolder)) to iFolderSelected // get folder name\r
+ move (CoTaskMemFree(lpItemIdList)) to l_iRetval // release memory used by ItemIdList\r
+\r
+ if (iFolderSelected = 0) move "" to sFolder\r
+ \r
+ function_return (cString(sFolder)) // return with terminating null char removed\r
+end_function\r
+\r
+// Function to convert a long filename into a windows short filename\r
+function get_short_path global string argv returns string\r
+ local string sShortPath sLongPath\r
+ local pointer lpszShortPath lpszLongPath\r
+ local integer cchBuffer l_iResult\r
+ \r
+ move (trim(argv)) to sLongPath\r
+ move 255 to cchBuffer\r
+ move (repeat(character(0),(cchBuffer+1))) to sShortPath\r
+ getaddress of sLongPath to lpszLongPath\r
+ getaddress of sShortPath to lpszShortPath\r
+ move (GetShortPathName(lpszLongPath,lpszShortPath,cchBuffer)) to l_iResult\r
+ \r
+ function_return (left(sShortPath,l_iResult))\r
+end_function\r
+\r
+// Set of function to disable close widgets of shell\r
+function disable_close global integer argv returns integer\r
+ local number Ret\r
+ local handle hWnd hMenu\r
+\r
+ if (g_sConsoleTitleIsSet <> "DataFlex") begin\r
+ // change the window title so we can find the window\r
+ move (SetConsoleTitle("DataFlex")) to strmark \r
+ move "DataFlex" to g_sConsoleTitleIsSet\r
+ // Give SetConsoleTitle a chance to take effect\r
+ sleep 1\r
+ end\r
+ \r
+ // find the window\r
+ move (FindWindow(0, "DataFlex")) to hWnd\r
+ // grab the menu\r
+ move (GetSystemMenu(hWnd, 0)) to hMenu\r
+ // disable the X\r
+ if (argv = 0) move (EnableMenuItem(hMenu, SC_CLOSE, (MF_BYCOMMAND ior MF_GRAYED))) to ret\r
+ // enable the X \r
+ if (argv = 1) move (EnableMenuItem(hMenu, SC_CLOSE, (MF_BYCOMMAND ior MF_ENABLED))) to ret\r
+ \r
+ function_return 0\r
+end_function\r
+\r
+// This function will run any external application directly from dataflex\r
+// argv = application to run (command name/path) argv2 = any parameters to pass to the program argv3 = directory to run from\r
+function shell_exec global string argv string argv2 string argv3 returns integer\r
+ local handle windowHandle\r
+ local pointer lpOperation lpFile lpParameters lpDirectory\r
+ local integer nShowCmd l_iResult\r
+ local string sOperation sFile sParameters sDirectory\r
+\r
+ if ((trim(argv)) <> "") begin\r
+ move 0 to windowHandle\r
+ move "open" to sOperation\r
+ move argv to sFile\r
+ if ((trim(argv2)) <> "") move argv2 to sParameters\r
+ else move "" to sParameters \r
+ if ((trim(argv3)) <> "") move argv3 to sDirectory\r
+ else move "" to sDirectory\r
+ move "" to sDirectory\r
+\r
+ getAddress of sOperation to lpOperation\r
+ getAddress of sFile to lpFile\r
+ getAddress of sParameters to lpParameters\r
+ getAddress of sDirectory to lpDirectory\r
+\r
+ move (ShellExecute(windowHandle,lpOperation,lpFile,lpParameters,lpDirectory,SW_SHOWMAXIMIZED)) to l_iResult\r
+ end\r
+end_function\r
+\r
+// This function will run the console application stated in argv1\r
+// argv2 = set to 1 to run the process in a new window\r
+// argv3 = set to 1 to leave the new process running and continue without killing it\r
+// argv4 = The time to live before killing the process - set to zero to wait until finished\r
+// Note - Setting argv3 to 1 will result in build up of open handles for finished processes \r
+// if term_proc is not used to terminate the process.\r
+// It is possible to have multiple processes running in one window by\r
+// setting argv2 = 0 and argv3 = 1, but handling how they behave on the screen \r
+// requires some careful fiddling.\r
+function create_proc global string argv integer argv2 integer argv3 integer argv4 returns string\r
+ local pointer lpProcessInformation lpStartupInformation\r
+ local integer l_iResult\r
+ local pointer lpApplicationName lpCommandLine lpProcessAttributes lpThreadAttributes lpEnvironment lpCurrentDirectory\r
+ local integer bInheritHandles iProcessAttributes iThreadAttributes iEnvironment \r
+ local dword dwCreationFlags dwMilliseconds\r
+ local string sProcessInformation sStartupInformation sApplicationName sCommandLine sCurrentDirectory l_sExit l_sTmp\r
+ local handle hProcess hThread\r
+ \r
+ zeroType _PROCESS_INFORMATION to sProcessInformation\r
+ zeroType _STARTUPINFO to sStartupInformation\r
+\r
+ move STRINGNULL to l_sExit\r
+ move STRINGNULL to sApplicationName\r
+ move argv to sCommandLine\r
+ move HEXNULL to iProcessAttributes\r
+ move HEXNULL to iThreadAttributes\r
+ move HEXTRUE to bInheritHandles\r
+ move HEXNULL to iEnvironment\r
+ move STRINGNULL to sCurrentDirectory\r
+ if (argv2 = 0) move NORMAL_PRIORITY_CLASS to dwCreationFlags\r
+ if (argv2 = 1) move (CREATE_NEW_CONSOLE+NORMAL_PRIORITY_CLASS) to dwCreationFlags\r
+ \r
+ getaddress of sApplicationName to lpApplicationName\r
+ getaddress of sCommandLine to lpCommandLine\r
+ getaddress of iProcessAttributes to lpProcessAttributes\r
+ getaddress of iThreadAttributes to lpThreadAttributes\r
+ getaddress of iEnvironment to lpEnvironment\r
+ getaddress of sCurrentDirectory to lpCurrentDirectory\r
+ getaddress of sProcessInformation to lpProcessInformation\r
+ getaddress of sStartupInformation to lpStartupInformation\r
+ \r
+ put (length(sStartupInformation)) to sStartupInformation at STARTUPINFO.cb\r
+ \r
+ move (CreateProcess(lpApplicationName,lpCommandLine,lpProcessAttributes,lpThreadAttributes,dwCreationFlags,dwCreationFlags,lpEnvironment,lpCurrentDirectory,lpStartupInformation,lpProcessInformation)) to l_iResult\r
+ \r
+ getbuff from sProcessInformation at PROCESS_INFORMATION.hProcess to hProcess\r
+ getbuff from sProcessInformation at PROCESS_INFORMATION.hThread to hThread\r
+\r
+ if (argv3 <> 1) begin\r
+ if (argv4 = 0) move INFINITE to dwMilliseconds\r
+ if (argv4 <> 0) move argv4 to dwMilliseconds\r
+ move (WaitForSingleObject(hProcess,dwMilliseconds)) to l_iResult\r
+ move (TerminateProcess(hProcess,HEXNULL)) to l_iResult\r
+ move (CloseHandle(hThread)) to l_iResult\r
+ move (CloseHandle(hProcess)) to l_iResult\r
+ end\r
+ if (argv3 = 1) begin \r
+ move hProcess to l_sExit\r
+ append l_sExit "|" hThread\r
+ end\r
+ \r
+ function_return l_sExit\r
+end_function\r
+\r
+// This will terminate a process started in create_proc with argv3 set to 1\r
+// move the string returned by create_proc to argv\r
+// set argv2 to 0 if you want to wait for the process to finish before terminating\r
+// set argv2 to 1 if you want to terminate the process without waiting for it to finish\r
+function term_proc global string argv integer argv2 returns integer\r
+ local integer l_iSuccess\r
+ local integer dwMilliseconds l_iResult\r
+ local handle hProcess hThread\r
+ \r
+ move 0 to l_iSuccess\r
+ move (trim(argv)) to argv\r
+ if ((argv contains "|") and ((length(argv)) >= 3)) begin \r
+ move (left(argv,(pos("|",argv)-1))) to hProcess\r
+ move (mid(argv,(length(argv)-pos("|",argv)),(pos("|",argv)+1))) to hThread\r
+ move INFINITE to dwMilliseconds\r
+ if (argv2 = 0) move (WaitForSingleObject(hProcess,dwMilliseconds)) to l_iResult\r
+ move (TerminateProcess(hProcess,HEXNULL)) to l_iResult\r
+ move (CloseHandle(hThread)) to l_iResult\r
+ move (CloseHandle(hProcess)) to l_iResult\r
+ end\r
+ \r
+ function_return l_iSuccess\r
+end_function\r
+\r
+// Check if a file is locked by a windows process\r
+// Returns 1 if the file is locked.\r
+function is_locked global string argv returns integer\r
+ local integer l_iResult l_iDllErr l_iThrow\r
+ local handle l_hFile \r
+ move 0 to l_iResult\r
+ move -1 to l_hFile\r
+ move (trim(argv)) to argv \r
+ if (argv <> "") begin\r
+ move (lOpen(argv,(OF_READ+OF_SHARE_EXCLUSIVE))) to l_hFile\r
+ move (GetLastError()) to l_iDllErr\r
+ if ((l_hFile = -1) and (l_iDllErr = 32)) move 1 to l_iResult\r
+ if (l_hFile <> -1) begin\r
+ move (lClose(l_hFile)) to l_iThrow\r
+ end\r
+ end\r
+ function_return l_iResult\r
+end_function\r
+\r
+// Check if a file exists. Returns 1 if the file exists.\r
+function does_exist global string argv returns integer\r
+ local integer l_iResult l_iDllErr l_iThrow\r
+ local handle l_hFile \r
+ move 0 to l_iResult\r
+ move -1 to l_hFile\r
+ move (trim(argv)) to argv \r
+ if (argv <> "") begin\r
+ move 1 to l_iResult\r
+ move (lOpen(argv,(OF_READ+OF_SHARE_DENY_NONE))) to l_hFile\r
+ move (GetLastError()) to l_iDllErr\r
+ if ((l_hFile = -1) and (l_iDllErr = 2)) move 0 to l_iResult\r
+ if (l_hFile <> -1) begin\r
+ move (lClose(l_hFile)) to l_iThrow\r
+ end\r
+ end\r
+ function_return l_iResult\r
+end_function\r
+\r
+// Read a text file line by line into the buffer array "Win32API_buffer"\r
+// Returns an integer i-1 where i is the count of array elements/lines.\r
+//\r
+// Ref: http:// msdn2.microsoft.com/en-us/library/aa365467.aspx\r
+function buffer_text_file global string argv string argv2 returns integer\r
+ local string l_sBuf l_sBufL l_structBytesRead l_sLine // String l_structBytesRead used with struct to overcome problem of df not being able to getaddress of integers\r
+ local handle l_hFileHandle l_hFile\r
+ local pointer l_pFileName l_pBuf l_pBytesRead\r
+ local integer l_iFileSize l_iThrow l_iBytesRead l_iBytesToRead l_i l_iDllErr l_iLines\r
+ \r
+ send delete_data to Win32API_buffer\r
+ move -1 to l_iLines\r
+ \r
+ move (trim(argv)) to argv\r
+ move (trim(argv2)) to argv2\r
+ move -1 to l_hFileHandle\r
+ move 0 to l_iBytesRead\r
+ move 1 to l_iBytesToRead\r
+ move "" to l_sLine\r
+ \r
+ if (argv <> "") begin\r
+ getaddress of argv to l_pFileName\r
+ move (CreateFile(l_pFileName,GENERIC_READ,FILE_SHARE_READ,HexNull,OPEN_EXISTING,0,HexNull)) to l_hFile\r
+ move (GetFileSize(l_hFile,0)) to l_iFileSize\r
+ for l_i from 1 to l_iFileSize\r
+ // move (SetFilePointer(l_hFile,l_i,0,FILE_CURRENT)) to l_iThrow\r
+ zerostring 1 to l_sBuf\r
+ getaddress of l_sBuf to l_pBuf\r
+ zerotype _STRUCTBYTESREAD to l_structBytesRead\r
+ getaddress of l_structBytesRead to l_pBytesRead\r
+ move (ReadFile(l_hFile,l_pBuf,l_iBytesToRead,l_pBytesRead,HexNull)) to l_iThrow\r
+ getbuff from l_structBytesRead at STRUCTBYTESREAD.integer0 to l_iBytesRead\r
+ if ((ascii(l_sBuf) = 10) or (ascii(l_sBuf) = 13) or ((argv2 <> "") and (argv2 = l_sBuf))) begin\r
+ if (ascii(l_sBufL) <> 13) begin\r
+ increment l_iLines\r
+ set array_value of (Win32API_buffer(current_object)) item l_iLines to l_sLine\r
+ move "" to l_sLine\r
+ end\r
+ \r
+ end\r
+ if ((ascii(l_sBuf) <> 10) and (ascii(l_sBuf) <> 13) and ((argv2 = "") or (argv2 <> l_sBuf))) append l_sLine l_sBuf\r
+ move l_sBuf to l_sBufL\r
+ end \r
+ move (CloseHandle(l_hFile)) to l_iThrow\r
+ end\r
+ function_return l_iLines\r
+end_function\r
+\r
+// Return file size in bytes from win32\r
+function file_size_bytes global string argv returns integer\r
+ local integer l_iFileSize l_iThrow\r
+ local pointer l_pFileName\r
+ local handle l_hFile\r
+ \r
+ move -1 to l_iFileSize\r
+ \r
+ if (argv <> "") begin\r
+ getaddress of argv to l_pFileName\r
+ move (CreateFile(l_pFileName,GENERIC_READ,FILE_SHARE_READ,HexNull,OPEN_EXISTING,0,HexNull)) to l_hFile\r
+ move (GetFileSize(l_hFile,0)) to l_iFileSize\r
+ move (CloseHandle(l_hFile)) to l_iThrow\r
+ end\r
+ \r
+ function_return l_iFileSize\r
+end_function\r
+\r
+// Attempt to convert a string from unicode to ASCII/cp850 via WideCharToMultiByte\r
+// http:// msdn2.microsoft.com/en-us/library/ms776420.aspx\r
+function to_ascii global string argv returns string\r
+ local string l_sAscii l_sUnicode\r
+ local pointer l_pAscii l_pUnicode\r
+ local integer l_iCharsNeeded l_iThrow\r
+ move (trim(argv)) to l_sUnicode\r
+ \r
+ if (l_sUnicode <> "") begin\r
+ zerostring 100 to l_sAscii\r
+ getAddress of l_sAscii to l_pAscii\r
+ getAddress of l_sUnicode to l_pUnicode\r
+ \r
+ // set the length of cchWideChar to -1 and function assumes null termination and calculates lenght itsself\r
+ move (WideCharToMultiByte(CP_OEMCP,0,l_pUnicode,-1,0,0,0,0)) to l_iCharsNeeded \r
+ move (WideCharToMultiByte(CP_OEMCP,0,l_pUnicode,-1,l_pAscii,l_iCharsNeeded,0,0)) to l_iThrow\r
+ end\r
+ function_return l_sAscii\r
+end_function\r
+\r
+// Attempt to convert a string from ASCII to unicode via MultiByteToWideChar\r
+function to_unicode global string argv returns string\r
+ local string l_sAscii l_sUnicode\r
+ local pointer l_pAscii l_pUnicode\r
+ local integer l_iCharsNeeded l_iThrow\r
+ move (trim(argv)) to l_sAscii\r
+ \r
+ if (l_sAscii <> "") begin\r
+ zerostring 100 to l_sUnicode\r
+ getAddress of l_sUnicode to l_pUnicode\r
+ getAddress of l_sAscii to l_pAscii\r
+ \r
+ // set the length of cchWideChar to -1 and function assumes null termination and calculates lenght itsself\r
+ move (MultiByteToWideChar(CP_ACP,0,l_pAscii,-1,0,0,0,0)) to l_iCharsNeeded \r
+ move (MultiByteToWideChar(CP_ACP,0,l_pAscii,-1,l_pUnicode,l_iCharsNeeded,0,0)) to l_iThrow\r
+ end\r
+ function_return l_sUnicode \r
+end_function\r
+\r
+// Attempt to convert a string from ascii to UTF8 via WideCharToMultiByte\r
+function to_utf8 global string argv returns string\r
+ local string l_sUTF8 l_sUnicode\r
+ local pointer l_pUTF8 l_pUnicode\r
+ local integer l_iCharsNeeded l_iThrow\r
+ move (trim(argv)) to l_sUnicode\r
+ \r
+ if (l_sUnicode <> "") begin\r
+ zerostring 100 to l_sUTF8\r
+ getAddress of l_sUTF8 to l_pUTF8\r
+ getAddress of l_sUnicode to l_pUnicode\r
+ \r
+ // set the length of cchWideChar to -1 and function assumes null termination and calculates lenght itsself\r
+ move (WideCharToMultiByte(CP_UTF8,0,l_pUTF8,-1,0,0,0,0)) to l_iCharsNeeded \r
+ move (WideCharToMultiByte(CP_UTF8,0,l_pUTF8,-1,l_pUnicode,l_iCharsNeeded,0,0)) to l_iThrow\r
+ end\r
+ \r
+ function_return l_sUTF8\r
+end_function\r
+\r
+// Get running processes on the system\r
+// http:// msdn2.microsoft.com/en-us/library/ms682629.aspx\r
+// in progress - currently churns out list of process id's to screen\r
+function get_procs global integer argv returns integer\r
+ local string l_sProcesses l_sStructBytesBack l_sBuf l_sModules\r
+ local integer l_iThrow l_iBytes l_iBytes2 l_iBytesBack l_iBytesBack2 l_i l_j l_iPid l_iMid\r
+ local pointer l_pProcesses l_pBytesBack l_pBytesBack2 l_pModules\r
+ local handle l_hProcess\r
+ \r
+ move (1024*10) to l_iBytes \r
+ zerostring l_iBytes to l_sProcesses\r
+ move 0 to l_iBytesBack\r
+ \r
+ getAddress of l_sProcesses to l_pProcesses \r
+ zerotype _STRUCTBYTESBACK to l_sStructBytesBack\r
+ getaddress of l_sStructBytesBack to l_pBytesBack\r
+ \r
+ move (EnumProcesses(l_pProcesses,l_iBytes,l_pBytesBack)) to l_iThrow\r
+\r
+ getbuff from l_sStructBytesBack at STRUCTBYTESBACK.integer0 to l_iBytesBack\r
+ \r
+ if (mod(l_iBytesBack,4) = 0) begin\r
+ for l_i from 1 to (l_iBytesBack/4)\r
+ move (left(l_sProcesses,4)) to l_sBuf\r
+ move (mid(l_sProcesses,(length(l_sProcesses)-4),5)) to l_sProcesses\r
+ getbuff from l_sBuf at PROCESSARRAY.arrayItem to l_iPid \r
+ move (OpenProcess((PROCESS_VM_READ ior PROCESS_QUERY_INFORMATION),HEXNULL,l_iPid)) to l_hProcess\r
+ \r
+ move 1024 to l_iBytes2\r
+ zerostring l_iBytes2 to l_sModules\r
+ getAddress of l_sModules to l_pModules\r
+ zerotype _STRUCTBYTESBACK to l_sStructBytesBack\r
+ getaddress of l_sStructBytesBack to l_pBytesBack2\r
+ \r
+ move (EnumProcessModules(l_hProcess,l_pModules,l_iBytes2,l_pBytesBack2)) to l_iThrow\r
+ getbuff from l_sStructBytesBack at STRUCTBYTESBACK.integer0 to l_iBytesBack2\r
+ \r
+ // Err here \r
+ showln l_i " PROC=" l_iPid " BYTES=" l_iBytesBack2 " H=" l_hProcess " LERR=" (GetLastError())\r
+ \r
+ // showln l_iBytesBack2 " " l_hProcess\r
+ if (mod(l_iBytesBack2,4) = 0) begin\r
+ for l_j from 1 to (l_iBytesBack2/4)\r
+ move (left(l_sModules,4)) to l_sBuf\r
+ move (mid(l_sModules,(length(l_sModules)-4),5)) to l_sModules\r
+ getbuff from l_sBuf at PROCESSARRAY.arrayItem to l_iMid\r
+\r
+ loop\r
+ end\r
+ move (CloseHandle(l_hProcess)) to l_iThrow\r
+ \r
+ loop\r
+ end\r
+ \r
+ showln l_iThrow\r
+ showln "BYTES " l_iBytesBack\r
+ \r
+ function_return 0\r
+end_function\r
+\r
+// Returns the current system time via the GetSystemTime call\r
+// Takes an integer value; \r
+// 1 - displays individual segments comma separated\r
+// 0 - displays a formatted date time\r
+function time_data global integer argv returns string\r
+ local string sTimeData sResult sFormattedTime sFormattedDate\r
+ local pointer pTimeData pFormattedTime pFormattedDate\r
+ local integer iThrow iYear iMonth iDayOfWeek iDay iHour iMinute iSecond iMilliSeconds iLenCcTime iLenCcDate iDataLength\r
+ \r
+ zeroType _SYSTEMTIME to sTimeData\r
+ getAddress of sTimeData to pTimeData\r
+ move (GetSystemTime(pTimeData)) to iThrow\r
+ \r
+ // just return the structure comma separated\r
+ if (argv = 1) begin\r
+ getBuff from sTimeData at SYSTEMTIME.wYear to iYear\r
+ getBuff from sTimeData at SYSTEMTIME.wMonth to iMonth\r
+ getBuff from sTimeData at SYSTEMTIME.wDayOfWeek to iDayOfWeek\r
+ getBuff from sTimeData at SYSTEMTIME.wDay to iDay\r
+ getBuff from sTimeData at SYSTEMTIME.wHour to iHour\r
+ getBuff from sTimeData at SYSTEMTIME.wMinute to iMinute\r
+ getBuff from sTimeData at SYSTEMTIME.wSecond to iSecond\r
+ getBuff from sTimeData at SYSTEMTIME.wMilliSeconds to iMilliSeconds\r
+ \r
+ move "" to sResult\r
+ append sResult iYear "," iMonth "," iDay "," iHour "," iMinute "," iSecond "," iMilliSeconds\r
+ end \r
+ // give formatted date_time\r
+ if (argv = 0) begin \r
+ zerostring 255 to sFormattedTime\r
+ getaddress of sFormattedTime to pFormattedTime\r
+ move (length(sFormattedTime)) to iLenCcTime\r
+ \r
+ move (GetTimeFormat("LOCALE_USER_DEFAULT", 0, pTimeData, 0, pFormattedTime, iLenCcTime)) to iDataLength\r
+\r
+ zerostring 255 To sFormattedDate\r
+ getaddress of sFormattedDate To pFormattedDate\r
+ move (length(sFormattedDate)) to iLenCcDate\r
+ \r
+ move (GetDateFormat("LOCALE_USER_DEFAULT", 0, pTimeData, 0, pFormattedDate, iLenCcDate)) to iDataLength\r
+ move (cstring(sFormattedDate)) to sResult\r
+ append sResult " " (cstring(sFormattedTime)) // terminating null char removed \r
+ end\r
+ function_return sResult\r
+end_function\r
+\r
+// Insert zeros into the correct places to make a field x wide (similar to zeropad)\r
+function fill_0 global integer iValue integer iSize returns string\r
+ local string sReturn\r
+\r
+ move iValue to sReturn\r
+ while (length(sReturn) < iSize)\r
+ insert '0' in sReturn at 1\r
+ end\r
+\r
+ function_return sReturn\r
+end_function\r
+\r
+// Checks the runtime date format and if it's not adding on the epoch add it\r
+function check_date_error global string sDate returns date\r
+ local integer iDate iY1k\r
+ local Date dDate\r
+\r
+ move sDate to iDate\r
+ move 693975 to iY1k\r
+\r
+ if (iDate < iY1k) Calc (iDate + iY1k) to iDate\r
+ move iDate to dDate\r
+\r
+ function_return dDate\r
+end_function\r
+\r
+// Get the mod time of a file\r
+// This is the core of the replacement / leap year fix of GET_FILE_MOD_TIME\r
+// Usage:\r
+// get_time(<file>, <mode>)\r
+// 1 = created time\r
+// 2 = accessed time\r
+// 3 = modified time\r
+// \r
+function get_time global string sFileName integer iMode returns string\r
+ local string sCreated sLastAccess sLastChanged sSystemTime sLocalTime sDate sTime sDateSep\r
+ Local pointer pCreated pLastAccess pLastChanged pSystemTime pLocalTime pFileName\r
+ Local handle hCheckFile\r
+ Local integer iResult iVal iDateSep iDateFormat iDate4State\r
+\r
+ move "" to sTime\r
+ move "" to sDate\r
+ \r
+ getaddress of sFileName to pFileName\r
+ move (CreateFile(pFileName, GENERIC_READ, FILE_SHARE_READ, 0, OPEN_EXISTING , 0, 0)) to hCheckFile\r
+ \r
+ if (hCheckFile <> INVALID_HANDLE_VALUE) begin\r
+ zerotype _FILETIME to sCreated\r
+ zerotype _FILETIME to sLastAccess\r
+ zerotype _FILETIME to sLastChanged\r
+ zerotype _FILETIME to sLocalTime\r
+ getAddress of sCreated to pCreated\r
+ getAddress of sLastAccess to pLastAccess\r
+ getAddress of sLastChanged to pLastChanged\r
+ getAddress of sLocalTime to pLocalTime\r
+\r
+ move (GetFileTime (hCheckFile, pCreated, pLastAccess, pLastChanged)) to iResult \r
+ \r
+ if (iResult) begin\r
+ if (iMode = 1) move (FileTimeToLocalFileTime(pCreated,pLocalTime)) to iResult\r
+ else if (iMode = 2) move (FileTimeToLocalFileTime(pLastAccess, pLocalTime)) to iResult\r
+ else if (iMode = 3) move (FileTimeToLocalFileTime(pLastChanged, pLocalTime)) to iResult\r
+ \r
+ zerotype _SYSTEMTIME2 to sSystemTime\r
+ getAddress of sSystemTime to pSystemTime\r
+\r
+ move (FileTimeToSystemTime(pLocalTime, pSystemTime)) to iResult\r
+\r
+ get_attribute DF_DATE_SEPARATOR to iDateSep\r
+ move (character(iDateSep)) to sDateSep\r
+ get_attribute DF_DATE_FORMAT to iDateFormat\r
+\r
+ if (iDateFormat = DF_DATE_USA) begin\r
+ getbuff from sSystemTime at SYSTEMTIME2.wMonth to iVal\r
+ append sDate (fill_0(iVal,2))\r
+ getbuff from sSystemTime at SYSTEMTIME2.wDay to iVal\r
+ append sDate sDateSep (fill_0(iVal,2))\r
+ getbuff from sSystemTime at SYSTEMTIME2.wYear to iVal\r
+ append sDate sDateSep (fill_0(iVal,4))\r
+ end\r
+ else if iDateFormat eq DF_DATE_EUROPEAN begin\r
+ getbuff from sSystemTime at SYSTEMTIME2.wDay to iVal\r
+ append sDate (fill_0(iVal,2))\r
+ getbuff from sSystemTime at SYSTEMTIME2.wMonth to iVal\r
+ append sDate sDateSep (fill_0(iVal,2))\r
+ getbuff from sSystemTime at SYSTEMTIME2.wYear to iVal\r
+ append sDate sDateSep (fill_0(iVal,4))\r
+ end\r
+ else if iDateFormat eq DF_DATE_MILITARY begin\r
+ getbuff from sSystemTime at SYSTEMTIME2.wYear to iVal\r
+ append sDate (fill_0(iVal,4))\r
+ getbuff from sSystemTime at SYSTEMTIME2.wMonth to iVal\r
+ append sDate sDateSep (fill_0(iVal,2))\r
+ getbuff from sSystemTime at SYSTEMTIME2.wDay to iVal\r
+ append sDate sDateSep (fill_0(iVal,2))\r
+ end\r
+\r
+ getbuff from sSystemTime at SYSTEMTIME2.wHour to iVal\r
+ append sTime (fill_0(iVal,2))\r
+ getbuff from sSystemTime at SYSTEMTIME2.wMinute to iVal\r
+ append sTime ":" (fill_0(iVal,2))\r
+ getbuff from sSystemTime at SYSTEMTIME2.wSecond to iVal\r
+ append sTime ":" (fill_0(iVal,2))\r
+\r
+ append sDate sTime\r
+ end\r
+ move (CloseHandle (hCheckFile)) to iResult\r
+ end\r
+\r
+ function_return sDate\r
+end_function\r
+\r
+// Create a guid GUID (Microsoft)\r
+function create_guid global returns string \r
+ local integer l_iThrow\r
+ local pointer l_ptGUID l_ptGUIDString\r
+ local string l_stGUID l_stGUIDString l_sResult\r
+ \r
+ zerotype _GUID to l_stGUID\r
+ getaddress of l_stGUID to l_ptGUID\r
+\r
+ zerostring GUID_STRING_LENGTH to l_stGUIDString\r
+ getaddress of l_stGUIDString to l_ptGUIDString\r
+ \r
+ if (CoCreateGuid(l_ptGUID) = 0) begin\r
+ // If successfully created put it in a string\r
+ move (StringFromGUID2(l_ptGUID, l_ptGUIDString, GUID_STRING_LENGTH)) to l_iThrow\r
+ move (cstring(to_ascii(l_stGUIDString))) to l_sResult\r
+ end\r
+ \r
+ function_return l_sResult\r
+end_function\r
+\r
+// Get textual description of a win32 error returned by GetLastError()\r
+function get_last_error_detail global integer iError returns string\r
+ local integer l_iThrow\r
+ local string l_sBuf \r
+ local pointer l_pBuf\r
+ \r
+ zerostring 200 to l_sBuf\r
+ getaddress of l_sBuf to l_pBuf\r
+ \r
+ move (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0, iError, LANG_NEUTRAL, l_pBuf, 200, 0)) to l_iThrow\r
+ \r
+ function_return (string(iError)+": "+l_sBuf)\r
+end_function\r
+\r
+// Get system disk info\r
+// argv1 = disk mount point i.e. c:\\r
+// argv2 = "" or "TOTAL", where TOTAL returns free and blank displays used.\r
+function disk_info global string argv string argv2 returns number\r
+ local string l_sSectorsPerCluster l_sBytesPerSector l_sNumberOfFreeClusters l_sTotalNumberOfClusters\r
+ local pointer l_pSectorsPerCluster l_pBytesPerSector l_pNumberOfFreeClusters l_pTotalNumberOfClusters\r
+ local number l_iSectorsPerCluster l_iBytesPerSector l_iNumberOfFreeClusters l_iTotalNumberOfClusters l_iSpace\r
+ \r
+ move 0 to l_iSpace\r
+\r
+ if (argv <> "") begin\r
+ zerotype _DISKDATA1 to l_sSectorsPerCluster\r
+ zerotype _DISKDATA2 to l_sBytesPerSector \r
+ zerotype _DISKDATA3 to l_sNumberOfFreeClusters \r
+ zerotype _DISKDATA4 to l_sTotalNumberOfClusters\r
+\r
+ getaddress of l_sSectorsPerCluster to l_pSectorsPerCluster\r
+ getaddress of l_sBytesPerSector to l_pBytesPerSector\r
+ getaddress of l_sNumberOfFreeClusters to l_pNumberOfFreeClusters\r
+ getaddress of l_sTotalNumberOfClusters to l_pTotalNumberOfClusters\r
+\r
+ showln (GetDiskFreeSpace(argv, l_pSectorsPerCluster, l_pBytesPerSector, l_pNumberOfFreeClusters, l_pTotalNumberOfClusters))\r
+\r
+ getbuff from l_sSectorsPerCluster at DISKDATA1.sectorsPerCluster to l_iSectorsPerCluster\r
+ getbuff from l_sBytesPerSector at DISKDATA2.bytesPerSector to l_iBytesPerSector\r
+ getbuff from l_sNumberOfFreeClusters at DISKDATA3.numberOfFreeClusters to l_iNumberOfFreeClusters\r
+ getbuff from l_sTotalNumberOfClusters at DISKDATA4.totalNumberOfClusters to l_iTotalNumberOfClusters\r
+\r
+ // showln l_iSectorsPerCluster\r
+ // showln l_iBytesPerSector \r
+ // showln l_iNumberOfFreeClusters\r
+ // showln l_iTotalNumberOfClusters\r
+ \r
+ if (argv2 = "TOTAL") calc (l_iSectorsPerCluster*l_iBytesPerSector*l_iTotalNumberOfClusters) to l_iSpace\r
+ else calc (l_iSectorsPerCluster*l_iBytesPerSector*l_iNumberOfFreeClusters) to l_iSpace\r
+ end\r
+ \r
+ function_return l_iSpace\r
+end_function\r
+\r
+// Get system memory usage\r
+function get_mem_usage global returns integer\r
+ local integer l_iThrow l_iPid l_iMem\r
+ local string l_sProcessMemoryCounters\r
+ local pointer l_lpProcessMemoryCounters\r
+ local handle l_hProcess\r
+\r
+ zeroType _PROCESS_MEMORY_COUNTERS to l_sProcessMemoryCounters\r
+ getaddress of l_sProcessMemoryCounters to l_lpProcessMemoryCounters\r
+\r
+ put (length(l_sProcessMemoryCounters)) to l_sProcessMemoryCounters at PROCESS_MEMORY_COUNTERS.cb\r
+\r
+ move (get_process_id(0)) to l_iPid\r
+ move (OpenProcess((PROCESS_VM_READ ior PROCESS_QUERY_INFORMATION),HEXNULL,l_iPid)) to l_hProcess\r
+\r
+ move (GetProcessMemoryInfo(l_hProcess, l_lpProcessMemoryCounters, length(l_sProcessMemoryCounters))) to l_iThrow\r
+ getbuff from l_sProcessMemoryCounters at PROCESS_MEMORY_COUNTERS.WorkingSetSize to l_iMem\r
+ \r
+ // showln l_hProcess " " l_iThrow\r
+ // showln (GetLastError())\r
+ // showln (get_last_error_detail(GetLastError()))\r
+\r
+ function_return l_iMem\r
+end_function\r
+\r
+// Uses Microsofts InternetCanonicalizeUrl functionality\r
+// http:// msdn.microsoft.com/en-us/library/windows/desktop/aa384342%28v=vs.85%29.aspx\r
+// https:// groups.google.com/forum/#!topic/microsoft.public.vb.winapi/0RY8jPsx_14\r
+function urldecode global string argv returns string\r
+ local string l_szUrl l_szBuffer l_szStructBytesRead l_sResult\r
+ local pointer l_lpszUrl l_lpszBuffer l_lpdwBufferLength \r
+ local integer l_iwBufferLength l_iResult l_iDllErr\r
+\r
+ move argv to l_szUrl\r
+ move argv to l_sResult\r
+ \r
+ if (length(l_szUrl) > 0) begin\r
+ zerostring ((length(l_szUrl))+1) to l_szBuffer\r
+ getaddress of l_szUrl to l_lpszUrl\r
+ getaddress of l_szBuffer to l_lpszBuffer\r
+ \r
+ zerotype _STRUCTBYTESREAD to l_szStructBytesRead\r
+ put ((length(l_szBuffer))*4) to l_szStructBytesRead at STRUCTBYTESREAD.integer0 // allow 4 bytes per char to generously allow for any length changes (should be 2)\r
+ getaddress of l_szStructBytesRead to l_lpdwBufferLength\r
+\r
+ move (InternetCanonicalizeUrl(l_lpszUrl, l_lpszBuffer, l_lpdwBufferLength, ICU_NO_ENCODE+ICU_DECODE)) to l_iResult\r
+\r
+ getbuff from l_szStructBytesRead at STRUCTBYTESREAD.integer0 to l_iwBufferLength\r
+\r
+ if (l_iResult <> 1) begin\r
+ move (GetLastError()) to l_iDllErr\r
+ custom_error ERROR_CODE_URLDECODE$ ERROR_MSG_URLDECODE ERROR_DETAIL_GETLASTERROR (get_last_error_detail(l_iDllErr))\r
+ end\r
+ move (cstring(l_szBuffer)) to l_sResult \r
+ end \r
+ function_return l_sResult \r
+end_function\r
+\r
+// Uses Microsofts InternetCanonicalizeUrl functionality\r
+// Only encodes parts before ? and #\r
+function urlencode global string argv returns string\r
+ local string l_szUrl l_szBuffer l_szStructBytesRead l_sResult\r
+ local pointer l_lpszUrl l_lpszBuffer l_lpdwBufferLength \r
+ local integer l_iwBufferLength l_iResult l_iDllErr\r
+\r
+ move argv to l_szUrl\r
+ move argv to l_sResult\r
+ if (length(l_szUrl) > 0) begin\r
+ zerostring ((length(l_szUrl))+1) to l_szBuffer\r
+ getaddress of l_szUrl to l_lpszUrl\r
+ getaddress of l_szBuffer to l_lpszBuffer\r
+ \r
+ zerotype _STRUCTBYTESREAD to l_szStructBytesRead\r
+ put ((length(l_szBuffer))*4) to l_szStructBytesRead at STRUCTBYTESREAD.integer0 // allow 4 bytes per char to generously allow for any length changes (should be 2)\r
+ getaddress of l_szStructBytesRead to l_lpdwBufferLength\r
+\r
+ move (InternetCanonicalizeUrl(l_lpszUrl, l_lpszBuffer, l_lpdwBufferLength, ICU_BROWSER_MODE)) to l_iResult\r
+\r
+ getbuff from l_szStructBytesRead at STRUCTBYTESREAD.integer0 to l_iwBufferLength\r
+\r
+ if (l_iResult <> 1) begin\r
+ move (GetLastError()) to l_iDllErr\r
+ custom_error ERROR_CODE_URLENCODE$ ERROR_MSG_URLENCODE ERROR_DETAIL_GETLASTERROR (get_last_error_detail(l_iDllErr))\r
+ end\r
+ move (cstring(l_szBuffer)) to l_sResult \r
+ end \r
+ function_return l_sResult \r
+end_function\r
+\r
+// Functions to pull windows os version string\r
+function get_os_version global returns string\r
+ local string l_sOsInfo l_sVersion l_sReturn\r
+ local pointer l_pOsInfo\r
+ local integer l_iResult l_iMajor l_iMinor l_iBuild l_iPlatform\r
+ \r
+ move "" to l_sVersion\r
+ \r
+ zerotype _OSVERSIONINFO to l_sOsInfo\r
+ put (length(l_sOsInfo)) to l_sOsInfo at OSVERSIONINFO.dwOSVersionInfoSize\r
+ getaddress of l_sOsInfo to l_pOsInfo\r
+ \r
+ move (GetVersionEx(l_pOsInfo)) to l_iResult\r
+ \r
+ if (l_iResult = 1) begin\r
+ getbuff from l_sOsInfo at OSVERSIONINFO.dwMajorVersion to l_iMajor\r
+ getbuff from l_sOsInfo at OSVERSIONINFO.dwMinorVersion to l_iMinor\r
+ getbuff from l_sOsInfo at OSVERSIONINFO.dwBuildNumber to l_iBuild\r
+ getbuff from l_sOsInfo at OSVERSIONINFO.dwPlatformId to l_iPlatform\r
+ // getbuff from l_sOsInfo at OSVERSIONINFO.szCSDVersion to l_sVersion !??\r
+ move (cstring(right(l_sOsInfo,128))) to l_sVersion\r
+ end\r
+ \r
+ move ("Windows Version: "+string(l_iMajor)+"."+string(l_iMinor)+" Build: "+string(l_iBuild)+" Platform: "+string(l_iPlatform)+" CSDVersion: "+l_sVersion) to l_sReturn\r
+ \r
+ function_return l_sReturn \r
+end_function\r
+\r
+// Functions to pull windows os version as a numeric value\r
+function get_os_version_numeric global returns number\r
+ local string l_sOsInfo l_sVersion\r
+ local pointer l_pOsInfo\r
+ local integer l_iResult l_iMajor l_iMinor l_iBuild l_iPlatform\r
+ \r
+ move "" to l_sVersion\r
+ \r
+ zerotype _OSVERSIONINFO to l_sOsInfo\r
+ put (length(l_sOsInfo)) to l_sOsInfo at OSVERSIONINFO.dwOSVersionInfoSize\r
+ getaddress of l_sOsInfo to l_pOsInfo\r
+ \r
+ move (GetVersionEx(l_pOsInfo)) to l_iResult\r
+ \r
+ if (l_iResult = 1) begin\r
+ getbuff from l_sOsInfo at OSVERSIONINFO.dwMajorVersion to l_iMajor\r
+ getbuff from l_sOsInfo at OSVERSIONINFO.dwMinorVersion to l_iMinor\r
+ end\r
+ \r
+ function_return (number(l_iMajor)+(number(l_iMinor)/10))\r
+end_function\r
+\r
+// Converts binary to hex or base64 strings and vice versa\r
+function binary_to_string_to_binary global string argv string argv2 string argv3 returns string\r
+ local string l_sData l_sDataDecoded l_sDataSizeDecoded l_sReturn\r
+ local pointer l_pData l_pDataDecoded l_pDataSizeDecoded\r
+ local integer l_iResult l_iDataSize l_iDataSizeDecoded l_iOffset\r
+ \r
+ move argv to l_sData\r
+ move (length(l_sData)) to l_iDataSize\r
+ getaddress of l_sData to l_pData\r
+ \r
+ zerostring ((length(l_sData)*4)+1) to l_sDataDecoded\r
+ getaddress of l_sDataDecoded to l_pDataDecoded\r
+ \r
+ zerotype _DW_TYPE to l_sDataSizeDecoded\r
+ put (length(l_sDataDecoded)) to l_sDataSizeDecoded at DW_TYPE.value\r
+ getaddress of l_sDataSizeDecoded to l_pDataSizeDecoded \r
+ \r
+ case begin\r
+ case (argv2 = "HEX") begin\r
+ if (argv3 = 0) move (CryptBinaryToString(l_pData, l_iDataSize, CRYPT_STRING_HEX, l_pDataDecoded, l_pDataSizeDecoded)) to l_iResult\r
+ if (argv3 = 1) move (CryptStringToBinary(l_pData, l_iDataSize, CRYPT_STRING_HEX, l_pDataDecoded, l_pDataSizeDecoded, HEXNULL, HEXNULL)) to l_iResult\r
+ end\r
+ case break\r
+ case (argv2 = "BASE64") begin\r
+ if (argv3 = 0) move (CryptBinaryToString(l_pData, l_iDataSize, CRYPT_STRING_BASE64, l_pDataDecoded, l_pDataSizeDecoded)) to l_iResult\r
+ if (argv3 = 1) move (CryptStringToBinary(l_pData, l_iDataSize, CRYPT_STRING_BASE64, l_pDataDecoded, l_pDataSizeDecoded, HEXNULL, HEXNULL)) to l_iResult\r
+ end\r
+ case break\r
+ case else custom_error ERROR_CODE_UNKNOWN_FORMAT$ ERROR_MSG_UNKNOWN_FORMAT argv2\r
+ case end\r
+\r
+ getbuff from l_sDataSizeDecoded at DW_TYPE.value to l_iDataSizeDecoded\r
+\r
+ if ((l_iResult <> 1) and (GetLastError() <> 0)) begin\r
+ showln "ERROR: " (ternary(argv3 = 0, "CryptBinaryToString", "CryptStringToBinary")) " " l_iResult " - " (GetLastError()) " - " (get_last_error_detail(GetLastError()))\r
+ showln "DATA = " l_sDataDecoded\r
+ showln "SIZE = " l_iDataSizeDecoded\r
+ end\r
+ else begin\r
+ if (argv3 = 0) move (replaces(character(9),replaces(character(10),replaces(character(13),replaces(character(32),cstring(mid(l_sDataDecoded,l_pDataSizeDecoded-l_iOffset,1+l_iOffset)),""),""),""),"")) to l_sReturn \r
+ else move (cstring(mid(l_sDataDecoded,l_pDataSizeDecoded-l_iOffset,1+l_iOffset))) to l_sReturn\r
+ end\r
+ \r
+ function_return l_sReturn\r
+end_function\r
+\r
+// Convert binary data to hex or base64 \r
+function binary_to_string global string argv string argv2 returns string\r
+ function_return (binary_to_string_to_binary(argv, argv2, 0))\r
+end_function\r
+// Convert hex or base64 strings to binary data\r
+function string_to_binary global string argv string argv2 returns string\r
+ function_return (binary_to_string_to_binary(argv, argv2, 1))\r
+end_function\r
+\r
+// List out cryptographic providers on ms windows\r
+function ms_adv_listproviders global returns integer\r
+ local integer l_i l_iResult l_iType\r
+ local string l_sType l_sName l_sNameSize\r
+ local pointer l_pType l_pName l_pNameSize\r
+\r
+ move -1 to l_i\r
+ repeat\r
+ increment l_i\r
+ \r
+ zerotype _DW_TYPE to l_sType\r
+ getaddress of l_sType to l_pType\r
+ \r
+ zerostring 255 to l_sName\r
+ getaddress of l_sName to l_pName\r
+ \r
+ zerotype _DW_TYPE to l_sNameSize\r
+ put length(l_sName) to l_sNameSize at DW_TYPE.value\r
+ getaddress of l_sNameSize to l_pNameSize\r
+ \r
+ move (CryptEnumProviders(l_i, HEXNULL, 0, l_pType, l_pName, l_pNameSize)) to l_iResult\r
+\r
+ if ((l_iResult <> 1) and (GetLastError() <> 0) and (GetLastError() <> 259)) begin\r
+ showln "ERROR: " (GetLastError()) " - " (get_last_error_detail(GetLastError()))\r
+ end\r
+ getbuff from l_sType at DW_TYPE.value to l_iType\r
+ \r
+ if (l_iResult = 1) showln l_i ") " l_iType " - '" (cstring(l_sName)) "'"\r
+ until (l_iResult <> 1)\r
+\r
+end_function\r
+\r
+//-------------------------------------------------------------------------\r
+// Classes\r
+//-------------------------------------------------------------------------\r
+\r
+// Object to provide basic implimentations of some popular hash algorithms and encryption\r
+// provided by the Microsoft Cryptographic Provider\r
+//\r
+// Send message methods:\r
+//\r
+// aquire_context - Create the context of the Microsoft CSP\r
+// release_context - Release the context of the Microsoft CSP\r
+// import_key <key> <ealg> - Incomplete/WIP\r
+// derive_key <psw> <halg> <ealg>- Derives an encryption key provider when supplied\r
+// with a password, a hash algorithm and the required \r
+// encryption.\r
+// modify_key_iv <iv> - Set the initilization vector of the key provider\r
+// modify_key_mode <mode> - Set the key provider mode E.g. CBC, ECB etc\r
+// destroy_key - Dispose of the current key provider\r
+//\r
+// Get methods:\r
+// hash_data <data> <halg> - Returns a hash of the passed data in the specified \r
+// algorithm\r
+// export_key - Returns the current encryption key\r
+// generate_random_key_iv - Generates and sets a random initilization vector \r
+// for the key provider\r
+// encrypt <data> - Encrypt data\r
+// decrypt <data> - Decrypt data\r
+//\r
+// Example usage:\r
+// \r
+// object test is an msAdvCrypt\r
+// end_object\r
+// string data buf\r
+// \r
+// // Generate a hash\r
+// send aquire_context to test\r
+// get hash_data of test "MYTEXT" "SHA1" to data\r
+// send release_context to test\r
+// showln "HASHED: " (binary_to_string(data,"HEX"))\r
+// \r
+// // Encrypt some data\r
+// send aquire_context to test\r
+// send derive_key to test "MYPASSWORD" "SHA256" "AES_256"\r
+// send modify_key_mode to test "CBC"\r
+// get generate_random_key_iv of test to buf\r
+// move buf to data\r
+// get encrypt of test "MYDATA" to buf\r
+// append data buf\r
+// send destroy_key to test\r
+// send release_context to test\r
+// showln "ENCRYPTED: " (binary_to_string(data,"HEX"))\r
+// \r
+// // Decrypt some data\r
+// send aquire_context to test\r
+// send derive_key to test "MYPASSWORD" "SHA256" "AES_256"\r
+// send modify_key_mode to test "CBC"\r
+// send modify_key_iv to test (mid(data,16,1))\r
+// get decrypt of test (mid(data,length(data)-16,17)) to data\r
+// send destroy_key to test\r
+// send release_context to test\r
+// showln "DECRYPTED: " data\r
+// \r
+class msAdvCrypt is an array\r
+ procedure construct_object string argc \r
+ forward send construct_object argc\r
+ \r
+ property handle c_hProv \r
+ property handle c_hHash \r
+ property handle c_hKey\r
+ property string c_sAlg\r
+ end_procedure\r
+\r
+ procedure aquire_context\r
+ local integer l_iResult\r
+ local handle l_hProv\r
+ local string l_shProv\r
+ local pointer l_phProv\r
+ \r
+ zerotype _DW_TYPE to l_shProv\r
+ getaddress of l_shProv to l_phProv\r
+ \r
+ if (get_os_version_numeric() < 5.2) begin\r
+ move (CryptAcquireContext(l_phProv, HEXNULL, MS_ENH_RSA_AES_PROV_XP, PROV_RSA_AES, CRYPT_VERIFYCONTEXT)) to l_iResult\r
+ if (GetLastError() = -2146893802) begin\r
+ move (CryptAcquireContext(l_phProv, HEXNULL, MS_ENH_RSA_AES_PROV_XP, PROV_RSA_AES, CRYPT_NEWKEYSET)) to l_iResult\r
+ end\r
+ end\r
+ else begin\r
+ move (CryptAcquireContext(l_phProv, HEXNULL, MS_ENH_RSA_AES_PROV, PROV_RSA_AES, CRYPT_VERIFYCONTEXT)) to l_iResult\r
+ if (GetLastError() = -2146893802) begin\r
+ move (CryptAcquireContext(l_phProv, HEXNULL, MS_ENH_RSA_AES_PROV, PROV_RSA_AES, CRYPT_NEWKEYSET)) to l_iResult\r
+ end\r
+ end\r
+ \r
+ if ((l_iResult <> 1) and (GetLastError() <> 0)) begin\r
+ showln "ERROR: CryptAcquireContext " l_iResult " - " (GetLastError()) " - " (get_last_error_detail(GetLastError()))\r
+ end\r
+ else begin\r
+ getbuff from l_shProv at DW_TYPE.value to l_hProv\r
+ set c_hProv to l_hProv\r
+ end \r
+ end_procedure\r
+ \r
+ function make_hash string in_data string in_hashalgorithm returns string\r
+ local integer l_iResult l_iHashSize\r
+ local string l_shHash l_sHash l_sRawString l_sHashSize\r
+ local handle l_hProv l_hHash\r
+ local pointer l_phHash l_pHash l_pRawString l_pHashSize\r
+ \r
+ get c_hProv to l_hProv\r
+ \r
+ if (l_hProv = 0) begin\r
+ custom_error ERROR_CODE_NO_CONTEXT$ ERROR_MSG_NO_CONTEXT\r
+ end\r
+ else begin\r
+ move in_data to l_sRawString\r
+ getaddress of l_sRawString to l_pRawString\r
+ \r
+ zerotype _HCRYPTHASH to l_shHash\r
+ getaddress of l_shHash to l_phHash \r
+ \r
+ case begin\r
+ case (in_hashalgorithm = "MD5") begin\r
+ move (CryptCreateHash(l_hProv, CALG_MD5, 0, 0, l_phHash)) to l_iResult\r
+ zerostring (128/8) to l_sHash\r
+ end\r
+ case break \r
+ case ((in_hashalgorithm = "SHA1") or (in_HASHalgorithm = "SHA")) begin\r
+ move (CryptCreateHash(l_hProv, CALG_SHA1, 0, 0, l_phHash)) to l_iResult\r
+ zerostring (160/8) to l_sHash\r
+ end\r
+ case break\r
+ case (in_hashalgorithm = "SHA256") begin\r
+ move (CryptCreateHash(l_hProv, CALG_SHA_256, 0, 0, l_phHash)) to l_iResult\r
+ zerostring (256/8) to l_sHash \r
+ end\r
+ case break\r
+ case (in_hashalgorithm = "SHA384") begin\r
+ move (CryptCreateHash(l_hProv, CALG_SHA_384, 0, 0, l_phHash)) to l_iResult\r
+ zerostring (384/8) to l_sHash \r
+ end\r
+ case break\r
+ case (in_hashalgorithm = "SHA512") begin\r
+ move (CryptCreateHash(l_hProv, CALG_SHA_512, 0, 0, l_phHash)) to l_iResult\r
+ zerostring (512/8) to l_sHash \r
+ end\r
+ case break \r
+ case else begin\r
+ custom_error ERROR_CODE_UNKNOWN_ALGORITHM$ ERROR_MSG_UNKNOWN_ALGORITHM in_hashalgorithm\r
+ end\r
+ case end \r
+ \r
+ if ((l_iResult <> 1) and (GetLastError() <> 0)) begin\r
+ showln "ERROR: CryptCreateHash " l_iResult " - " (GetLastError()) " - " (get_last_error_detail(GetLastError()))\r
+ end\r
+ \r
+ getbuff from l_shHash at HCRYPTHASH.value to l_hHash\r
+ getaddress of l_sHash to l_pHash\r
+ \r
+ move (CryptHashData(l_hHash, l_pRawString, (length(l_sRawString)), 0)) to l_iResult\r
+ \r
+ if ((l_iResult <> 1) and (GetLastError() <> 0)) begin\r
+ showln "ERROR: Crypthash_data " l_iResult " - " (GetLastError()) " - " (get_last_error_detail(GetLastError()))\r
+ end\r
+ \r
+ zerotype _DW_TYPE to l_sHashSize\r
+ put (length(l_sHash)) to l_sHashSize at DW_TYPE.value\r
+ getaddress of l_sHashSize to l_pHashSize\r
+ \r
+ move (CryptGetHashParam(l_hHash, HP_HASHVAL, l_pHash, l_pHashSize, 0)) to l_iResult\r
+ \r
+ if ((l_iResult <> 1) and (GetLastError() <> 0)) begin\r
+ showln "ERROR: CryptGetHashParam " l_iResult " - " (GetLastError()) " - " (get_last_error_detail(GetLastError()))\r
+ end \r
+ \r
+ getbuff from l_sHashSize at DW_TYPE.value to l_iHashSize\r
+\r
+ if (l_iHashSize <> length(l_sHash)) begin\r
+ showln "WARNING: Binary data does not match expected hash size:"\r
+ showln "DATA = " l_sHash\r
+ showln "SIZE = " l_iHashSize " / " (length(l_sHash))\r
+ end \r
+ end\r
+ \r
+ set c_hHash to l_hHash \r
+ \r
+ function_return (mid(l_sHash,l_iHashSize,1))\r
+ end_function \r
+ \r
+ procedure destroy_hash\r
+ local integer l_iResult\r
+ local handle l_hHash\r
+ \r
+ get c_hHash to l_hHash\r
+\r
+ if (l_hHash <> 0) begin\r
+ move (CryptDestroyHash(l_hHash)) to l_iResult\r
+ if ((l_iResult <> 1) and (GetLastError() <> 0)) begin\r
+ showln "ERROR: Cryptdestroy_hash " l_iResult " - " (GetLastError()) " - " (get_last_error_detail(GetLastError()))\r
+ end \r
+ else set c_hHash to 0\r
+ end \r
+ end_procedure\r
+\r
+ function hash_data string in_data string in_hashalgorithm returns string\r
+ local integer l_iResult\r
+ local string l_sHash\r
+ \r
+ get make_hash in_data in_hashalgorithm to l_sHash\r
+ send destroy_hash\r
+ \r
+ function_return (cstring(l_sHash))\r
+ end_function \r
+ \r
+ //WIP\r
+ procedure import_key string in_key string in_algorithm\r
+ local integer l_iResult\r
+ local string l_sBlobHeader l_sPlainTextKeyBlob l_shKey\r
+ local handle l_hProv l_hKey\r
+ local pointer l_pPlainTextKeyBlob l_phKey\r
+ \r
+ get c_hProv to l_hProv \r
+ \r
+ zerotype _BLOBHEADER to l_sBlobHeader \r
+ put PLAINTEXTKEYBLOB to l_sBlobHeader at BLOBHEADER.bType\r
+ put 2 to l_sBlobHeader at BLOBHEADER.bVersion\r
+ put 0 to l_sBlobHeader at BLOBHEADER.Reserved\r
+ \r
+ case begin \r
+ case (in_algorithm = "DES") put CALG_DES to l_sBlobHeader at BLOBHEADER.ALG_ID\r
+ case break \r
+ case (in_algorithm = "3DES") put CALG_3DES to l_sBlobHeader at BLOBHEADER.ALG_ID\r
+ case break \r
+ case (in_algorithm = "3DES_112") put CALG_3DES_112 to l_sBlobHeader at BLOBHEADER.ALG_ID\r
+ case break \r
+ case (in_algorithm = "AES") put CALG_AES to l_sBlobHeader at BLOBHEADER.ALG_ID\r
+ case break \r
+ case (in_algorithm = "AES_128") put CALG_AES_128 to l_sBlobHeader at BLOBHEADER.ALG_ID\r
+ case break \r
+ case (in_algorithm = "AES_192") put CALG_AES_192 to l_sBlobHeader at BLOBHEADER.ALG_ID\r
+ case break \r
+ case (in_algorithm = "AES_256") put CALG_AES_256 to l_sBlobHeader at BLOBHEADER.ALG_ID\r
+ case break \r
+ case (in_algorithm = "RC2") put CALG_RC2 to l_sBlobHeader at BLOBHEADER.ALG_ID\r
+ case break \r
+ case (in_algorithm = "RC4") put CALG_RC4 to l_sBlobHeader at BLOBHEADER.ALG_ID \r
+ case break \r
+ case else custom_error ERROR_CODE_UNKNOWN_ALGORITHM$ ERROR_MSG_UNKNOWN_ALGORITHM in_algorithm\r
+ case end\r
+ \r
+ zerotype _PLAINTEXTKEYBLOB to l_sPlainTextKeyBlob\r
+ put l_sBlobHeader to l_sPlainTextKeyBlob at PLAINTEXTKEYBLOB.BLOBHEADER\r
+ put (length(in_key)) to l_sPlainTextKeyBlob at PLAINTEXTKEYBLOB.dwKeySize\r
+ put_string in_key to l_sPlainTextKeyBlob at PLAINTEXTKEYBLOB.rgbKeyData \r
+ \r
+ getaddress of l_sPlainTextKeyBlob to l_pPlainTextKeyBlob\r
+ \r
+ zerotype _HCRYPTKEY to l_shKey\r
+ getaddress of l_shKey to l_phKey\r
+ \r
+ move (CryptImportKey(l_hProv, l_pPlainTextKeyBlob, length(l_sPlainTextKeyBlob), 0, CRYPT_EXPORTABLE, l_phKey)) to l_iResult\r
+ \r
+ if ((l_iResult <> 1) and (GetLastError() <> 0)) begin\r
+ showln "ERROR: CryptImportKey " l_iResult " - " (GetLastError()) " - " (get_last_error_detail(GetLastError()))\r
+ end\r
+ \r
+ getbuff from l_shKey at HCRYPTKEY.value to l_hKey\r
+ \r
+ end_procedure\r
+ \r
+ procedure derive_key string in_data string in_hashalgorithm string in_algorithm\r
+ local integer l_iResult\r
+ local handle l_hProv l_hHash l_hKey\r
+ local string l_sKey l_shKey\r
+ local pointer l_phKey\r
+ \r
+ get c_hProv to l_hProv \r
+ get make_hash in_data in_hashalgorithm to l_sKey \r
+ get c_hHash to l_hHash\r
+\r
+ if (l_hHash <> 0) begin\r
+ zerotype _HCRYPTKEY to l_shKey\r
+ getaddress of l_shKey to l_phKey\r
+\r
+ // The default cipher mode to be used depends on the underlying CSP and the algorithm that's being used, but it's generally CBC mode\r
+ case begin\r
+ case (in_algorithm = "DES") move (CryptDeriveKey(l_hProv, CALG_DES, l_hHash, CRYPT_EXPORTABLE, l_phKey)) to l_iResult\r
+ case break \r
+ case (in_algorithm = "3DES") move (CryptDeriveKey(l_hProv, CALG_3DES, l_hHash, CRYPT_EXPORTABLE, l_phKey)) to l_iResult\r
+ case break \r
+ case (in_algorithm = "3DES_112") move (CryptDeriveKey(l_hProv, CALG_3DES_112, l_hHash, CRYPT_EXPORTABLE, l_phKey)) to l_iResult\r
+ case break \r
+ case (in_algorithm = "AES") move (CryptDeriveKey(l_hProv, CALG_AES, l_hHash, CRYPT_EXPORTABLE, l_phKey)) to l_iResult\r
+ case break \r
+ case (in_algorithm = "AES_128") move (CryptDeriveKey(l_hProv, CALG_AES_128, l_hHash, CRYPT_EXPORTABLE, l_phKey)) to l_iResult\r
+ case break \r
+ case (in_algorithm = "AES_192") move (CryptDeriveKey(l_hProv, CALG_AES_192, l_hHash, CRYPT_EXPORTABLE, l_phKey)) to l_iResult\r
+ case break \r
+ case (in_algorithm = "AES_256") move (CryptDeriveKey(l_hProv, CALG_AES_256, l_hHash, CRYPT_EXPORTABLE, l_phKey)) to l_iResult\r
+ case break \r
+ case (in_algorithm = "RC2") move (CryptDeriveKey(l_hProv, CALG_RC2, l_hHash, CRYPT_EXPORTABLE, l_phKey)) to l_iResult\r
+ case break \r
+ case (in_algorithm = "RC4") move (CryptDeriveKey(l_hProv, CALG_RC4, l_hHash, CRYPT_EXPORTABLE, l_phKey)) to l_iResult\r
+ case break \r
+ case else custom_error ERROR_CODE_UNKNOWN_ALGORITHM$ ERROR_MSG_UNKNOWN_ALGORITHM in_algorithm\r
+ case end\r
+ \r
+ if ((l_iResult <> 1) and (GetLastError() <> 0)) begin\r
+ showln "ERROR: CryptDeriveKey " l_iResult " - " (GetLastError()) " - " (get_last_error_detail(GetLastError()))\r
+ end\r
+ else begin \r
+ getbuff from l_shKey at HCRYPTKEY.value to l_hKey\r
+ set c_sAlg to in_algorithm\r
+ end\r
+\r
+ set c_hKey to l_hKey\r
+ end\r
+ end_procedure\r
+ \r
+ procedure modify_key_iv string in_iv\r
+ local integer l_iResult l_iBlockSize\r
+ local handle l_hKey\r
+ local string l_sIV l_sAlg\r
+ local pointer l_pIV\r
+ \r
+ get c_hKey to l_hKey\r
+ get c_sAlg to l_sAlg\r
+ \r
+ // Set expected block size in bytes\r
+ case begin\r
+ case (l_sAlg contains "DES") calc (64/8) to l_iBlockSize\r
+ case break \r
+ case (l_sAlg contains "AES") calc (128/8) to l_iBlockSize\r
+ case break \r
+ case (l_sAlg = "RC2") calc (64/8) to l_iBlockSize\r
+ case break \r
+ case else custom_error ERROR_CODE_INCOMPATIBLE_ALGORITHM$ ERROR_MSG_INCOMPATIBLE_ALGORITHM l_sAlg\r
+ case end\r
+ \r
+ if (length(in_iv) <> l_iBlockSize) custom_error ERROR_CODE_INVALID_BLOCKSIZE$ ERROR_MSG_INVALID_BLOCKSIZE (l_sAlg+"="+string(l_iBlockSize)+" NOT "+string(length(in_iv)))\r
+ \r
+ move in_iv to l_sIV\r
+ getaddress of l_sIV to l_pIV\r
+ \r
+ move (CryptSetKeyParam(l_hKey, KP_IV, l_pIV, 0)) to l_iResult\r
+ \r
+ if ((l_iResult <> 1) and (GetLastError() <> 0)) begin\r
+ showln "ERROR: CryptSetKeyParam " l_iResult " - " (GetLastError()) " - " (get_last_error_detail(GetLastError()))\r
+ end \r
+ \r
+ end_procedure\r
+ \r
+ function generate_random_key_iv returns string\r
+ local integer l_i l_iBlockSize\r
+ local string l_sIV l_sAlg \r
+ \r
+ get c_sAlg to l_sAlg\r
+ move "" to l_sIV\r
+ \r
+ if ((l_sAlg contains "DES") or (l_sAlg = "RC2")) calc (64/8) to l_iBlockSize\r
+ if (l_sAlg contains "AES") calc (128/8) to l_iBlockSize\r
+ \r
+ for l_i from 1 to l_iBlockSize\r
+ append l_sIV (character(48+random(47)))\r
+ loop\r
+ \r
+ send modify_key_iv l_sIV\r
+ \r
+ function_return l_sIV\r
+ end_function\r
+ \r
+ procedure modify_key_mode string in_mode\r
+ local integer l_iResult\r
+ local handle l_hKey\r
+ local string l_sMode l_sbData\r
+ local pointer l_pbData\r
+ \r
+ get c_hKey to l_hKey\r
+\r
+ case begin\r
+ case (in_mode contains "CBC") move CRYPT_MODE_CBC to l_sMode\r
+ case break\r
+ case (in_mode contains "ECB") move CRYPT_MODE_ECB to l_sMode\r
+ case break\r
+ case (in_mode contains "OFB") move CRYPT_MODE_OFB to l_sMode\r
+ case break\r
+ case (in_mode contains "CFB") move CRYPT_MODE_CFB to l_sMode\r
+ case break\r
+ case (in_mode contains "CTS") move CRYPT_MODE_CTS to l_sMode\r
+ case break \r
+ case else custom_error ERROR_CODE_UNRECOGNISED_MODE$ ERROR_MSG_UNRECOGNISED_MODE l_sMode \r
+ case end\r
+ \r
+ zerotype _DW_TYPE to l_sbData\r
+ put l_sMode to l_sbData at DW_TYPE.value\r
+ getaddress of l_sbData to l_pbData \r
+ \r
+ move (CryptSetKeyParam(l_hKey, KP_MODE, l_pbData, 0)) to l_iResult\r
+ \r
+ if ((l_iResult <> 1) and (GetLastError() <> 0)) begin\r
+ showln "ERROR: CryptSetKeyParam " l_iResult " - " (GetLastError()) " - " (get_last_error_detail(GetLastError()))\r
+ end \r
+ \r
+ end_procedure\r
+ \r
+ function export_key returns string\r
+ local integer l_iResult\r
+ local string l_sData l_sDataSize\r
+ local handle l_hKey\r
+ local pointer l_pData l_pDataSize\r
+ local integer l_iKeyBlobSize l_iDataSize\r
+ \r
+ get c_hKey to l_hKey\r
+ \r
+ if (l_hKey <> 0) begin\r
+ zerotype _PLAINTEXTKEYBLOB to l_sData\r
+ getaddress of l_sData to l_pData\r
+ \r
+ zerotype _DW_TYPE to l_sDataSize\r
+ put (length(l_sData)) to l_sDataSize at DW_TYPE.value\r
+ getaddress of l_sDataSize to l_pDataSize\r
+ \r
+ move (CryptExportKey(l_hKey, 0, PLAINTEXTKEYBLOB, 0, l_pData, l_pDataSize)) to l_iResult\r
+ if ((l_iResult <> 1) and (GetLastError() <> 0)) begin\r
+ showln "ERROR: CryptExportKey " l_iResult " - " (GetLastError()) " - " (get_last_error_detail(GetLastError()))\r
+ end \r
+ \r
+ getbuff from l_sDataSize at DW_TYPE.value to l_iKeyBlobSize\r
+ getbuff from l_sData at PLAINTEXTKEYBLOB.dwKeySize to l_iDataSize\r
+ move (mid(l_sData,l_iDataSize,13)) to l_sData\r
+ \r
+ if (show_debug_lines) begin\r
+ showln "DEBUG: Key blob Size = " l_iKeyBlobSize \r
+ end\r
+ end\r
+ function_return l_sData\r
+ end_function\r
+ \r
+ function encrypt_decrypt string in_data integer in_decrypt returns string\r
+ local integer l_iResult l_iDataSize\r
+ local string l_sData l_sDataSize\r
+ local pointer l_pData l_pDataSize \r
+ local handle l_hKey\r
+ \r
+ move in_data to l_sData \r
+ get c_hKey to l_hKey\r
+ \r
+ zerotype _DW_TYPE to l_sDataSize\r
+ put (length(l_sData)) to l_sDataSize at DW_TYPE.value\r
+ getaddress of l_sDataSize to l_pDataSize \r
+ \r
+ move (l_sData+repeat(' ',length(l_sData)*2)) to l_sData\r
+ getaddress of l_sData to l_pData \r
+ \r
+ if (in_decrypt = 0) move (CryptEncrypt(l_hKey, HEXNULL, HEXTRUE, 0, l_pData, l_pDataSize, length(l_sData))) to l_iResult\r
+ else move (CryptDecrypt(l_hKey, HEXNULL, HEXTRUE, 0, l_pData, l_pDataSize)) to l_iResult \r
+\r
+ if ((l_iResult <> 1) and (GetLastError() <> 0)) begin\r
+ showln "ERROR: " (ternary(in_decrypt = 0, "CryptEncrypt", "CryptDecrypt")) " " l_iResult " - " (GetLastError()) " - " (get_last_error_detail(GetLastError()))\r
+ end\r
+ \r
+ getbuff from l_sDataSize at DW_TYPE.value to l_iDataSize\r
+ move (cstring(mid(l_sData,l_iDataSize,1))) to l_sData\r
+ \r
+ function_return l_sData\r
+ end_function\r
+ \r
+ function encrypt string in_data returns string\r
+ local string l_sData\r
+ \r
+ get encrypt_decrypt in_data 0 to l_sData\r
+ function_return l_sData\r
+ end_function\r
+ \r
+ function decrypt string in_data returns string\r
+ local string l_sData\r
+ \r
+ get encrypt_decrypt in_data 1 to l_sData\r
+ function_return l_sData\r
+ end_function\r
+ \r
+ procedure destroy_key\r
+ local integer l_iResult\r
+ local handle l_hKey l_hHash\r
+ \r
+ get c_hKey to l_hKey\r
+ \r
+ if (l_hKey <> 0) begin\r
+ move (CryptDestroyKey(l_hKey)) to l_iResult \r
+ if ((l_iResult <> 1) and (GetLastError() <> 0)) begin\r
+ showln "ERROR: CryptDestroyKey " l_iResult " - " (GetLastError()) " - " (get_last_error_detail(GetLastError())) \r
+ end \r
+ else begin\r
+ set c_hKey to 0\r
+ set c_sAlg to ""\r
+ end\r
+ end\r
+ \r
+ get c_hHash to l_hHash\r
+ if (l_hHash <> 0) send destroy_hash \r
+ \r
+ end_procedure\r
+ \r
+ procedure release_context\r
+ local integer l_iResult\r
+ local handle l_hProv \r
+ \r
+ get c_hProv to l_hProv\r
+ \r
+ if (l_hProv <> 0) begin \r
+ move (CryptReleaseContext(l_hProv, 0)) to l_iResult\r
+ if ((l_iResult <> 1) and (GetLastError() <> 0)) begin\r
+ showln "ERROR: Cryptrelease_context " l_iResult " - " (GetLastError()) " - " (get_last_error_detail(GetLastError()))\r
+ end \r
+ else set c_hProv to 0\r
+ end\r
+ \r
+ end_procedure\r
+ \r
+ procedure destory_object\r
+ local handle l_hProv l_hHash l_hKey\r
+ \r
+ get c_hKey to l_hKey\r
+ if (l_hKey <> 0) send destroy_key\r
+ \r
+ get c_hHash to l_hHash\r
+ if (l_hHash <> 0) send destroy_hash\r
+ \r
+ get c_hProv to l_hProv\r
+ if (l_hProv <> 0) send release_context\r
+ \r
+ forward send destory_object\r
+ end_procedure\r
+ \r
+end_class\r
+\r
+//-------------------------------------------------------------------------\r
+// Functions\r
+//-------------------------------------------------------------------------\r
+\r
+// Used for procedural invocations of hashing and encrypting\r
+object msAdvCrypt_global_obj is an msAdvCrypt\r
+end_object\r
+\r
+// Procedural one-shot use of msAdvCrypt hashing\r
+function msAdvCrypt_hash global string in_data string in_hash returns string\r
+ local string l_sReturn\r
+ \r
+ send aquire_context to msAdvCrypt_global_obj\r
+ get make_hash of msAdvCrypt_global_obj in_data in_hash to l_sReturn\r
+ send destroy_hash to msAdvCrypt_global_obj\r
+ send release_context to msAdvCrypt_global_obj\r
+ \r
+ function_return l_sReturn\r
+end_function\r
+\r
+function sha512_hex global string in_data returns string\r
+ function_return (binary_to_string(msAdvCrypt_hash(in_data, "SHA512"),'HEX'))\r
+end_function\r
+\r
+function sha512_base64 global string in_data returns string\r
+ function_return (binary_to_string(msAdvCrypt_hash(in_data, "SHA512"),'BASE64'))\r
+end_function\r
+\r
+function sha384_hex global string in_data returns string\r
+ function_return (binary_to_string(msAdvCrypt_hash(in_data, "SHA384"),'HEX'))\r
+end_function\r
+\r
+function sha384_base64 global string in_data returns string\r
+ function_return (binary_to_string(msAdvCrypt_hash(in_data, "SHA384"),'BASE64'))\r
+end_function\r
+\r
+function sha256_hex global string in_data returns string\r
+ function_return (binary_to_string(msAdvCrypt_hash(in_data, "SHA256"),'HEX'))\r
+end_function\r
+\r
+function sha256_base64 global string in_data returns string\r
+ function_return (binary_to_string(msAdvCrypt_hash(in_data, "SHA256"),'BASE64'))\r
+end_function\r
+\r
+function sha1_hex global string in_data returns string\r
+ function_return (binary_to_string(msAdvCrypt_hash(in_data, "SHA1"),'HEX'))\r
+end_function\r
+\r
+function sha1_base64 global string in_data returns string\r
+ function_return (binary_to_string(msAdvCrypt_hash(in_data, "SHA1"),'BASE64'))\r
+end_function\r
+\r
+function md5_hex global string in_data returns string\r
+ function_return (binary_to_string(msAdvCrypt_hash(in_data, "MD5"),'HEX'))\r
+end_function\r
+\r
+function md5_base64 global string in_data returns string\r
+ function_return (binary_to_string(msAdvCrypt_hash(in_data, "MD5"),'BASE64'))\r
+end_function\r
+\r
+// Procedural one-shot use of msAdvCrypt AES256 encryption (HEX)\r
+function aes256_hex_enc global string in_data string in_key returns string\r
+ local string l_sReturn l_sBuf\r
+ \r
+ send aquire_context to msAdvCrypt_global_obj\r
+ \r
+ send derive_key to msAdvCrypt_global_obj in_key "SHA256" "AES_256"\r
+ send modify_key_mode to msAdvCrypt_global_obj "CBC"\r
+ \r
+ get generate_random_key_iv of msAdvCrypt_global_obj to l_sBuf \r
+ move l_sBuf to l_sReturn\r
+ \r
+ get encrypt of msAdvCrypt_global_obj in_data to l_sBuf\r
+ append l_sReturn l_sBuf\r
+ \r
+ send destroy_key to msAdvCrypt_global_obj \r
+ send release_context to msAdvCrypt_global_obj\r
+ \r
+ function_return (binary_to_string(l_sReturn,"HEX"))\r
+end_function\r
+\r
+// Procedural one-shot use of msAdvCrypt AES256 decryption (HEX)\r
+function aes256_hex_dec global string in_data string in_key returns string\r
+ local string l_sReturn l_sBuf\r
+ \r
+ move (string_to_binary(in_data,"HEX")) to l_sBuf\r
+ \r
+ send aquire_context to msAdvCrypt_global_obj \r
+ send derive_key to msAdvCrypt_global_obj in_key "SHA256" "AES_256"\r
+ send modify_key_mode to msAdvCrypt_global_obj "CBC"\r
+ \r
+ send modify_key_iv to msAdvCrypt_global_obj (mid(l_sBuf,16,1))\r
+ \r
+ get decrypt of msAdvCrypt_global_obj (mid(l_sBuf,length(l_sBuf)-16,17)) to l_sReturn\r
+ \r
+ send destroy_key to msAdvCrypt_global_obj \r
+ send release_context to msAdvCrypt_global_obj\r
+ \r
+ function_return l_sReturn\r
+end_function\r
projects / dataflex / df32func / commitdiff