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