Import initial din SVN ROAAUTO/Trunk @HEAD

This commit is contained in:
2026-04-11 17:11:32 +03:00
commit 656d98697f
1856 changed files with 163525 additions and 0 deletions

View File

@@ -0,0 +1,93 @@
Local loDate
Local lcReport
loDate = Createobject("empty")
AddProperty(loDate, "to", "0723197939")
AddProperty(loDate, "message", "test " + Ttoc(Datetime()))
AddProperty(loDate, "footer", "@MMM")
lcReport = sendsms(loDate)
Messagebox(m.lcReport)
XMLTOCURSOR()
**************************************
* plugin_sms_playsms
* Apeleaza api playsms Trimite catre playsms
* http://192.168.75.101/html/playsms
*/index.php?app=ws&u=admin&h=eabd6195724d56d08a5a2ca0573451b6&op=pv&to=0723197939&msg=test+only
**************************************
Procedure sendsms
Lparameters toDate
* toDate: .to, .message, .footer
#Define HTTPSTATUS_OK 200
#Define HTTPSTATUS_CREATED 201
#Define HTTPSTATUS_ACCEPTED 202
#Define HTTPSTATUS_MULTISTATUS 207
#Define HTTPSTATUS_BADREQUEST 400
#Define HTTPSTATUS_UNAUTHORIZED 401
#Define HTTPSTATUS_FORBIDDEN 403
#Define HTTPSTATUS_NOTFOUND 404
#Define HTTPSTATUS_INTERNALSERVERERROR 500
Local loHTTP As "Microsoft.XMLHTTP"
Local lcBaseURL, lcFooter, lcMessage, lcPluginPath, lcResponse, lcTo, lcToken, lcURL, lcUser
Local lcUtilsPath, lcwwhttp, lnStatus
lcPluginPath = Addbs(Justpath(Sys(16, 0)))
lcUtilsPath = m.lcPluginPath + 'utils\'
*!* Set Path To (m.lcUtilsPath) Additive
*!* lcwwhttp = m.lcUtilsPath + 'wwhttp.prg'
*!* Do (m.lcwwhttp)
lcBaseURL = [http://192.168.75.101/html/playsms]
lcUser = [admin]
lcToken = [eabd6195724d56d08a5a2ca0573451b6]
lcTo = toDate.To
lcMessage = urlencode(toDate.Message)
lcFooter = urlencode(toDate.Footer)
lcURL = m.lcBaseURL + [/index.php?app=ws&u=] + m.lcUser + [&h=] + m.lcToken + [&op=pv&to=] + m.lcTo + [&msg=] + m.lcMessage + [&format=xml] + Iif(!Empty(m.lcFooter), [&footer=] + m.lcFooter, [])
loHTTP = Createobject("Microsoft.XMLHTTP")
loHTTP.Open("GET", m.lcURL, .F.)
loHTTP.Send()
lnStatus = loHTTP.Status
If m.lnStatus = HTTPSTATUS_OK
lcResponse = loHTTP.responseText
Return lcResponse
Endif
Endproc && sendsms
Function urlencode
*
* from http://www.tek-tips.com/gviewthread.cfm/lev2/4/lev3/27/pid/184/qid/597112
* also http://fox.wikis.com/wc.dll?Wiki~VFPPortListener~VFP
* I'm confused by this code.
* I believe it doesn't translate spaces correctly
*
* a proper definition is in: http://www.ietf.org/rfc/rfc2396.txt
* starting about half way down page 5
* unreserved characters include all alphas, all digits and the following unreserved marks
* mark = "-" | "_" | "." | "!" | "~" | "*" | "'" | "(" | ")"
*
Lparameter pcinstr
* ' encode Percent signs
* ' Double Quotes
* ' CarriageReturn / LineFeeds
Local lcout, lni
lcout = ''
For lni = 1 To Len(pcinstr)
lcch = Substr(pcinstr, lni, 1)
Do Case
Case Isalpha(lcch) Or Isdigit(lcch) Or Inlist(lcch, "-", "_", ".", "!", "~", "*", "'", "(", ")")
* do nothing
Case lcch = " "
lcch = "+"
Otherwise
lcch = '%' + Right( Transform(Asc(lcch), '@0'), 2 )
Endcase
lcout = lcout + lcch
Endfor
Return lcout
Endfunc && UrlEncode

View File

@@ -0,0 +1,263 @@
************************************************************************
* WCONNECT Header File
**********************
*** Author: Rick Strahl
*** (c) West Wind Technologies, 1995-2002
*** Contact: http://www.west-wind.com/
*** Function: Global DEFINEs used by West Wind Web Connection.
***
*** IMPORTANT: Any changes made here or in WCONNECT_OVERRIDE.H
*** require a full recompile of all files that use
*** this header file!
************************************************************************
#DEFINE WWVERSION "Version 4.20"
#DEFINE WWVERSIONDATE "May 6, 2002"
*** DEBUGMODE effects how errors are handled.
*** If .T. errors are not handled and the server stops on errors.
*** If .F. the Web Connection error handlers kick in and
*** provide error pages and logging
#DEFINE DEBUGMODE .T.
*** Use this flag to handle different configurations
*** You can set up conditional DEFINES for applications
*** to easily switch configurations. (Optional - not used by framework)
*** 1 - Development Server
*** 2 - Live Server
#DEFINE LOCALSITE 1
*** When .T. server runs as a Top Level while running file based
#DEFINE SERVER_IN_DESKTOP .F.
*** Carriage Return/Line Break
#DEFINE CR CHR(13)+CHR(10) && DO NOT USE ANY MORE
#DEFINE CRLF CHR(13)+CHR(10)
*** Customizable default HTTP Header
#DEFINE DEFAULT_CONTENTTYPE_HEADER ;
"HTTP/1.1 200 OK" + CRLF + ;
"Content-type: text/html" + CRLF
#DEFINE DEFAULT_HTTP_VERSION "1.1"
*** Post boundary used for posting multipart vars
#DEFINE POST_BOUNDARY CHR(13)+CHR(10)+ "#@$ FORM VARIABLES $@#" + CHR(13)+CHR(10)
#DEFINE MULTIPART_BOUNDARY "-----------------------------7cf2a327f01ae"
*** SQL Connect String to database containing
*** wwSession and RequestLog files
#DEFINE WWC_USE_SQL_SYSTEMFILES .F.
*** Determines whether the store runs with SQL Server Tables
#DEFINE WWSTORE_USE_SQL_TABLES .F.
#DEFINE WWMSGBOARD_USE_SQL_TABLES .F.
*** Visual FoxPro Version Number Macro
#DEFINE wwVFPVERSION VAL(SUBSTR(Version(),ATC("FoxPro",VERSION())+7,2))
*** Determines whether TEMPLATE pages are cached (ExpandTemplate calls)
*** Note: This value specifies how often the file is checked for
*** a newer version in seconds. 0 means - don't cache.
#DEFINE WWC_CACHE_TEMPLATES 0
*** Maximum String size for the wwResponseString class
#DEFINE MAX_STRINGSIZE 8000
*** Maximum number of cells that ShowCursor generates
*** before reverting to <pre> list
#DEFINE MAX_TABLE_CELLS 15000
*** Special 'NULL' String to differentiate none from empty strings
#DEFINE WWC_NULLSTRING "*#*"
*** Defines the location of the Web Connection framework
*** the default is the current directory
#DEFINE WWC_FRAMEWORK_PATH ".\"
*** XML Size Id used for Memo Fields to differentiate memos from strings
*** This value is compatible with ADO's usage
#DEFINE XML_SCHEMA_MEMOSIZE 2147483647
#DEFINE XML_XMLDOM_PROGID "MSXML2.DOMDocument"
**"MSXML2.DOMDocument.4.0"
*** Determines whether wwXML::XMLTOCURSOR tries to use
*** VFP 7's XMLTOCURSOR. NOTE: Requires SP1!!!!
*** This can drastically improve performance for large data sets
#DEFINE WWXML_USE_VFP_XMLTOCURSOR .F.
*** Class Names - These classes are defined here and used in the code
*** so if you subclass an essential class you can change
*** the class used here and automatically have the framework
*** inherit from your subclass
#DEFINE WWC_SERVER wwServer
#DEFINE WWC_SERVERFORM wwServerForm
#DEFINE WWC_SERVERFORM_VFPFRAME wwServerFormVFPFrame
#DEFINE WWC_PROCESS wwProcess
#DEFINE WWC_WEBSERVICE wwWebService
#DEFINE WWC_SESSION wwSession
#DEFINE WWC_SQLSESSION wwSessionSQL
#DEFINE WWC_REQUEST wwRequest
#DEFINE WWC_REQUESTASP wwASPRequest
#DEFINE WWC_RESPONSE wwResponse
#DEFINE WWC_RESPONSEFILE wwResponseFile
#DEFINE WWC_RESPONSESTRING wwResponseStringNoBuffer
#DEFINE WWC_RESPONSEASP wwASPResponse
#DEFINE WWC_WWDHTMLFORM wwDhtmlForm
#DEFINE WWC_WWDHTMLCONTROL wwDhtmlControl
#DEFINE WWC_HTTPHEADER wwHTTPHeader
#DEFINE WWC_WWEVAL wwEval
#DEFINE WWC_WWVFPSCRIPT wwVFPScript
#DEFINE WWC_WWPDF wwPDF50
#DEFINE WWC_WWSOAP wwSOAP
#DEFINE WWC_WWBUSINESS wwBusiness
*** Class Include flags - Use these to make the install lighter - New 07/05/97
#DEFINE WWC_LOAD_WWSESSION .T.
#DEFINE WWC_LOAD_WWBANNER .T.
#DEFINE WWC_LOAD_WWSHOWCURSOR .T.
#DEFINE WWC_LOAD_WWDBFPOPUP .T.
#DEFINE WWC_LOAD_WWIPSTUFF .T.
#DEFINE WWC_LOAD_WWHTTP .T.
#DEFINE WWC_LOAD_WWBUSINESS .T.
#DEFINE WWC_LOAD_WWSQL .T.
#DEFINE WWC_LOAD_WWHTTPSQL .T.
#DEFINE WWC_LOAD_WWVFPSCRIPT .T.
#DEFINE WWC_LOAD_WWPDF .T.
#DEFINE WWC_LOAD_WWXML .T. && Don't change! Required!
#DEFINE WWC_LOAD_WWMSMQ .F.
#DEFINE WWC_LOAD_WWSOAP .T.
#DEFINE WWC_LOAD_DYNAMICHTML_FORMRENDERING .T.
*** VERSION CONSTANTS
#DEFINE SHAREWARE .F.
#DEFINE WWC_DEMO .T.
#DEFINE SWTIMEOUT 1800
#DEFINE HTMLCLASSONLY .F.
#DEFINE SHOWSQLERRORS .F.
#DEFINE FOXISAPI .F.
#DEFINE VISUALWEBBUILDER .F.
*** COMPATIBILITY CONSTANTS
*** Turn on for backwards compatibility
*** As features are removed they are bracketed in this flag.
#DEFINE WWC_COMPATIBILITY .F.
*** Use old Style button in Form Rendering
*** All buttons are rendered with the same name if .t.
*** END COMPATIBILITY CONSTANTS
*** Images in forms are pathed relative to the Web request
*** and must be located in the directory specified here
#DEFINE WWFORM_IMAGEPATH "formimages/"
#DEFINE WWFORM_USEOLD_BUTTONSTYLE .F.
*** wwList ActiveX Control settings - Changed 9/2/2000
#DEFINE WWLIST_USEOLDGRID .F.
#DEFINE WWLIST_CLASSID "36E500EB-8219-11D1-A398-00600889F23B"
#DEFINE WWLIST_CODEBASE "wwCTLS.cab"
#DEFINE LISTVIEW_CLASSID "BDD1F04B-858B-11D1-B16A-00C0F0283628"
#DEFINE LISTVIEW_CODEBASE "http://activex.microsoft.com/controls/vb6/MSComCtl.cab"
*** General WinINET Constants
#DEFINE INTERNET_OPEN_TYPE_PRECONFIG 0
#DEFINE INTERNET_OPEN_TYPE_DIRECT 1
#DEFINE INTERNET_OPEN_TYPE_PROXY 3
#DEFINE INTERNET_OPTION_CONNECT_TIMEOUT 2
#DEFINE INTERNET_OPTION_CONNECT_RETRIES 3
#DEFINE INTERNET_OPTION_SEND_TIMEOUT 5
#DEFINE INTERNET_OPTION_RECEIVE_TIMEOUT 6
#DEFINE INTERNET_OPTION_DATA_SEND_TIMEOUT 5
#DEFINE INTERNET_OPTION_DATA_RECEIVE_TIMEOUT 6
#DEFINE INTERNET_OPTION_LISTEN_TIMEOUT 11
#DEFINE INTERNET_SERVICE_FTP 1
#DEFINE INTERNET_DEFAULT_FTP_PORT 21
#DEFINE ERROR_INTERNET_EXTENDED_ERROR 12003
*** WinInet Service Flags
#DEFINE INTERNET_SERVICE_HTTP 3
#DEFINE INTERNET_DEFAULT_HTTP_PORT 80
#DEFINE INTERNET_DEFAULT_HTTPS_PORT 443
#DEFINE INTERNET_FLAG_RELOAD 2147483648
#DEFINE INTERNET_FLAG_SECURE 8388608
#define INTERNET_FLAG_KEEP_CONNECTION 0x00400000
#DEFINE HTTP_STATUS_PROXY_AUTH_REQ 407
#define HTTP_QUERY_STATUS_CODE 19
#define HTTP_QUERY_FLAG_NUMBER 0x20000000
#DEFINE HTTP_QUERY_RAW_HEADERS_CRLF 22
#define HTTP_QUERY_STATUS_CODE 19
#define HTTP_QUERY_STATUS_TEXT 20
#DEFINE FTP_TRANSFER_TYPE_ASCII 1
#DEFINE FTP_TRANSFER_TYPE_BINARY 2
#DEFINE INTERNET_FLAG_IGNORE_CERT_DATE_INVALID 0x00002000
*** Win32 API Constants
#DEFINE ERROR_SUCCESS 0
*** Access Flags
#DEFINE GENERIC_READ 0x80000000
#DEFINE GENERIC_WRITE 0x40000000
#DEFINE GENERIC_EXECUTE 0x20000000
#DEFINE GENERIC_ALL 0x10000000
*** File Attribute Flags
#DEFINE FILE_ATTRIBUTE_NORMAL 0x00000080
#DEFINE FILE_ATTRIBUTE_READONLY 0x00000001
#DEFINE FILE_ATTRIBUTE_HIDDEN 0x00000002
#DEFINE FILE_ATTRIBUTE_SYSTEM 0x00000004
*** Values for FormatMessage API
#DEFINE FORMAT_MESSAGE_FROM_SYSTEM 4096
#DEFINE FORMAT_MESSAGE_FROM_HMODULE 2048
*** Registry roots
#DEFINE HKEY_CLASSES_ROOT -2147483648 && (( HKEY ) 0x80000000 )
#DEFINE HKEY_CURRENT_USER -2147483647 && (( HKEY ) 0x80000001 )
#DEFINE HKEY_LOCAL_MACHINE -2147483646 && (( HKEY ) 0x80000002 )
#DEFINE HKEY_USERS -2147483645 && (( HKEY ) 0x80000003 )
*** Registry Value types
#DEFINE REG_NONE 0 && Undefined Type (default)
#DEFINE REG_SZ 1 && Regular Null Terminated String
#DEFINE REG_BINARY 3 && ??? (unimplemented)
#DEFINE REG_DWORD 4 && Long Integer value
#DEFINE MULTI_SZ 7 && Multiple Null Term Strings (not implemented)
*** Generic File Access Rights for NT ACLs
#define FILERIGHTS_READ 1179785
#define FILERIGHTS_READEXECUTE 1179817
#define FILERIGHTS_CHANGE 1245631
#define FILERIGHTS_FULL 2032127
**** CUSTOMIZE AND OVERRIDE SETTINGS INDEPENDENTLY
**** OF THE WC INSTALLATION
#IF FILE("WCONNECT_OVERRIDE.H")
#INCLUDE WCONNECT_OVERRIDE.H
#ENDIF
*!* WCONNECT_OVERRIDE.H would contain (for example):
*!* #UNDEFINE DEBUGMODE
*!* #DEFINE DEBUGMODE .T.
*!* #UNDEFINE SERVER_IN_DESKTOP
*!* #DEFINE SERVER_IN_DESKTOP .T.

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,929 @@
#INCLUDE WCONNECT.H
#DEFINE MAX_INI_BUFFERSIZE 512
#DEFINE MAX_INI_ENUM_BUFFERSIZE 8196
*************************************************************
DEFINE CLASS wwAPI AS Custom
*************************************************************
*** Author: Rick Strahl
*** (c) West Wind Technologies, 1997
*** Contact: (541) 386-2087 / rstrahl@west-wind.com
*** Function: Encapsulates several Windows API functions
*************************************************************
*** Custom Properties
nLastError=0
FUNCTION Init
************************************************************************
* wwAPI :: Init
*********************************
*** Function: DECLARES commonly used DECLAREs so they're not redefined
*** on each call to the methods.
************************************************************************
DECLARE INTEGER GetPrivateProfileString ;
IN WIN32API ;
STRING cSection,;
STRING cEntry,;
STRING cDefault,;
STRING @cRetVal,;
INTEGER nSize,;
STRING cFileName
DECLARE INTEGER GetCurrentThread ;
IN WIN32API
DECLARE INTEGER GetThreadPriority ;
IN WIN32API ;
INTEGER tnThreadHandle
DECLARE INTEGER SetThreadPriority ;
IN WIN32API ;
INTEGER tnThreadHandle,;
INTEGER tnPriority
*** Open Registry Key
DECLARE INTEGER RegOpenKey ;
IN Win32API ;
INTEGER nHKey,;
STRING cSubKey,;
INTEGER @nHandle
*** Create a new Key
DECLARE Integer RegCreateKey ;
IN Win32API ;
INTEGER nHKey,;
STRING cSubKey,;
INTEGER @nHandle
*** Close an open Key
DECLARE Integer RegCloseKey ;
IN Win32API ;
INTEGER nHKey
ENDFUNC
* Init
FUNCTION MessageBeep
************************************************************************
* wwAPI :: MessageBeep
**********************
*** Function: MessageBeep API call runs system sounds
*** Pass: lnSound - Uses FoxPro.h MB_ICONxxxxx values
*** Return: nothing
************************************************************************
LPARAMETERS lnSound
DECLARE INTEGER MessageBeep ;
IN WIN32API AS MsgBeep ;
INTEGER nSound
=MsgBeep(lnSound)
ENDFUNC
* MessageBeep
FUNCTION ReadRegistryString
************************************************************************
* wwAPI :: ReadRegistryString
*********************************
*** Function: Reads a string value from the registry.
*** Pass: tnHKEY - HKEY value (in CGIServ.h)
*** tcSubkey - The Registry subkey value
*** tcEntry - The actual Key to retrieve
*** tlInteger - Optional - Return an DWORD value
*** Return: Registry String or .NULL. on not found
************************************************************************
LPARAMETERS tnHKey, tcSubkey, tcEntry, tlInteger
LOCAL lnRegHandle, lnResult, lnSize, lcDataBuffer, tnType
tnHKey=IIF(vartype(tnHKey)="N",tnHKey,HKEY_LOCAL_MACHINE)
lnRegHandle=0
*** Open the registry key
lnResult=RegOpenKey(tnHKey,tcSubKey,@lnRegHandle)
IF lnResult#ERROR_SUCCESS
*** Not Found
RETURN .NULL.
ENDIF
*** Return buffer to receive value
IF !tlInteger
*** Need to define here specifically for Return Type
*** for lpdData parameter or VFP will choke.
*** Here it's STRING.
DECLARE INTEGER RegQueryValueEx ;
IN Win32API ;
INTEGER nHKey,;
STRING lpszValueName,;
INTEGER dwReserved,;
INTEGER @lpdwType,;
STRING @lpbData,;
INTEGER @lpcbData
lcDataBuffer=space(MAX_INI_BUFFERSIZE)
lnSize=LEN(lcDataBuffer)
lnType=REG_DWORD
lnResult=RegQueryValueEx(lnRegHandle,tcEntry,0,@lnType,;
@lcDataBuffer,@lnSize)
ELSE
*** Need to define here specifically for Return Type
*** for lpdData parameter or VFP will choke.
*** Here's it's an INTEGER
DECLARE INTEGER RegQueryValueEx ;
IN Win32API AS RegQueryInt;
INTEGER nHKey,;
STRING lpszValueName,;
INTEGER dwReserved,;
Integer @lpdwType,;
INTEGER @lpbData,;
INTEGER @lpcbData
lcDataBuffer=0
lnSize=4
lnType=REG_DWORD
lnResult=RegQueryInt(lnRegHandle,tcEntry,0,@lnType,;
@lcDataBuffer,@lnSize)
IF lnResult = ERROR_SUCCESS
RETURN lcDataBuffer
ELSE
RETURN -1
ENDIF
ENDIF
=RegCloseKey(lnRegHandle)
IF lnResult#ERROR_SUCCESS
*** Not Found
RETURN .NULL.
ENDIF
IF lnSize<2
RETURN ""
ENDIF
*** Return string and strip out NULLs
RETURN SUBSTR(lcDataBuffer,1,lnSize-1)
ENDFUNC
* ReadRegistryString
************************************************************************
* Registry :: WriteRegistryString
*********************************
*** Function: Writes a string value to the registry.
*** If the value doesn't exist it's created. If the key
*** doesn't exist it is also created, but this will only
*** succeed if it's the last key on the hive.
*** Pass: tnHKEY - HKEY value (in WCONNECT.h)
*** tcSubkey - The Registry subkey value
*** tcEntry - The actual Key to write to
*** tcValue - Value to write or .NULL. to delete key
*** tlCreate - Create if it doesn't exist
*** Assume: Use with extreme caution!!! Blowing your registry can
*** hose your system!
*** Return: .T. or .NULL. on error
************************************************************************
FUNCTION WriteRegistryString
LPARAMETERS tnHKey, tcSubkey, tcEntry, tcValue,tlCreate
LOCAL lnRegHandle, lnResult, lnSize, lcDataBuffer, tnType
tnHKey=IIF(type("tnHKey")="N",tnHKey,HKEY_LOCAL_MACHINE)
lnRegHandle=0
lnResult=RegOpenKey(tnHKey,tcSubKey,@lnRegHandle)
IF lnResult#ERROR_SUCCESS
IF !tlCreate
RETURN .F.
ELSE
lnResult=RegCreateKey(tnHKey,tcSubKey,@lnRegHandle)
IF lnResult#ERROR_SUCCESS
RETURN .F.
ENDIF
ENDIF
ENDIF
*** Need to define here specifically for Return Type!
*** Here lpbData is STRING.
DECLARE INTEGER RegSetValueEx ;
IN Win32API ;
INTEGER nHKey,;
STRING lpszEntry,;
INTEGER dwReserved,;
INTEGER fdwType,;
STRING lpbData,;
INTEGER cbData
*** Check for .NULL. which means delete key
IF !ISNULL(tcValue)
*** Nope - write new value
lnSize=LEN(tcValue)
if lnSize=0
tcValue=CHR(0)
ENDIF
lnResult=RegSetValueEx(lnRegHandle,tcEntry,0,REG_SZ,;
tcValue,lnSize)
ELSE
*** Delete a value from a key
DECLARE INTEGER RegDeleteValue ;
IN Win32API ;
INTEGER nHKEY,;
STRING cEntry
*** DELETE THE KEY
lnResult=RegDeleteValue(lnRegHandle,tcEntry)
ENDIF
=RegCloseKey(lnRegHandle)
IF lnResult#ERROR_SUCCESS
RETURN .F.
ENDIF
RETURN .T.
ENDPROC
* WriteRegistryString
FUNCTION EnumKey
************************************************************************
* wwAPI :: EnumRegistryKey
*********************************
*** Function: Returns a registry key name based on an index
*** Allows enumeration of keys in a FOR loop. If key
*** is empty end of list is reached.
*** Pass: tnHKey - HKEY_ root key
*** tcSubkey - Subkey string
*** tnIndex - Index of key name to get (0 based)
*** Return: "" on error - Key name otherwise
************************************************************************
LPARAMETERS tnHKey, tcSubKey, tnIndex
LOCAL lcSubKey, lcReturn, lnResult, lcDataBuffer
lnRegHandle=0
*** Open the registry key
lnResult=RegOpenKey(tnHKey,tcSubKey,@lnRegHandle)
IF lnResult#ERROR_SUCCESS
*** Not Found
RETURN .NULL.
ENDIF
DECLARE Integer RegEnumKey ;
IN WIN32API ;
INTEGER nHKey, ;
INTEGER nIndex, ;
STRING @cSubkey, ;
INTEGER nSize
lcDataBuffer=SPACE(MAX_INI_BUFFERSIZE)
lnSize=MAX_INI_BUFFERSIZE
lnResult=RegENumKey(lnRegHandle, tnIndex, @lcDataBuffer, lnSize)
=RegCloseKey(lnRegHandle)
IF lnResult#ERROR_SUCCESS
*** Not Found
RETURN .NULL.
ENDIF
RETURN TRIM(CHRTRAN(lcDataBuffer,CHR(0),""))
ENDFUNC
* EnumRegistryKey
FUNCTION GetProfileString
************************************************************************
* wwAPI :: GetProfileString
***************************
*** Modified: 09/26/95
*** Function: Read Profile String information from a given
*** text file using Windows INI formatting conventions
*** Pass: pcFileName - Name of INI file
*** pcSection - [Section] in the INI file ("Drivers")
*** pcEntry - Entry to retrieve ("Wave")
*** If this value is a null string
*** all values for the section are
*** retrieved seperated by CHR(13)s
*** Return: Value(s) or .NULL. if not found
************************************************************************
LPARAMETERS pcFileName,pcSection,pcEntry, pnBufferSize
LOCAL lcIniValue, lnResult
*pcFileName=IIF(TYPE("pcFileName")="C",pcFileName,"")
*pcSection=IIF(TYPE("pcSection")="C",pcSection,"")
*** Default to 0, which means all entries!
*pcEntry=IIF(TYPE("pcEntry")="C",pcEntry,0)
*** Initialize buffer for result
lcIniValue=SPACE(IIF( type("pnBufferSize")="N",pnBufferSize,MAX_INI_BUFFERSIZE) )
lnResult=GetPrivateProfileString(pcSection,pcEntry,"*None*",;
@lcIniValue,LEN(lcIniValue),pcFileName)
*** Strip out Nulls
IF TYPE("pcEntry")="N" AND pcEntry=0
*** 0 was passed to get all entry labels
*** Seperate all of the values with a Carriage Return
lcIniValue=TRIM(CHRTRAN(lcIniValue,CHR(0),CHR(13)) )
ELSE
*** Individual Entry
lcIniValue=SUBSTR(lcIniValue,1,lnResult)
ENDIF
*** On error the result contains "*None"
IF lcIniValue="*None*"
lcIniValue=.NULL.
ENDIF
RETURN lcIniValue
ENDFUNC
* GetProfileString
************************************************************************
* wwAPI :: GetProfileSections
*********************************
*** Function: Retrieves all sections of an INI File
*** Pass: @laSections - Empty array to receive sections
*** lcIniFile - Name of the INI file
*** lnBufSize - Size of result buffer (optional)
*** Return: Count of Sections
************************************************************************
FUNCTION aProfileSections
LPARAMETERS laSections, lcIniFile
LOCAL lnBufsize, lcBuffer, lnSize, lnResult, lnCount
lnBufsize=IIF(EMPTY(lnBufsize),16484,lnBufsize)
DECLARE INTEGER GetPrivateProfileSectionNames ;
IN WIN32API ;
STRING @lpzReturnBuffer,;
INTEGER nSize,;
STRING lpFileName
lcBuffer = SPACE(lnBufSize)
lnSize = lEN(lcBuffer)
lnResult = GetPrivateProfileSectionNames(@lcBuffer,lnSize,lcIniFile)
IF lnResult < 3
RETURN 0
ENDIF
lnCount = aParseString(@laSections,TRIM(lcBuffer),CHR(0))
lnCount = lnCount - 2
IF lnCount > 0
DIMENSION laSections[lnCount]
ENDIF
RETURN lnCount
ENDFUNC
* wwAPI :: aProfileSections
************************************************************************
* wwAPI :: WriteProfileString
*********************************
*** Function: Writes a value back to an INI file
*** Pass: pcFileName - Name of the file to write to
*** pcSection - Profile Section
*** pcKey - The key to write to
*** pcValue - The value to write
*** Return: .T. or .F.
************************************************************************
FUNCTION WriteProfileString
LPARAMETERS pcFileName,pcSection,pcEntry,pcValue
DECLARE INTEGER WritePrivateProfileString ;
IN WIN32API ;
STRING cSection,STRING cEntry,STRING cEntry,;
STRING cFileName
lnRetVal=WritePrivateProfileString(pcSection,pcEntry,pcValue,pcFileName)
if lnRetval=1
RETURN .t.
endif
RETURN .f.
ENDFUNC
* WriteProfileString
FUNCTION GetTempPath
************************************************************************
* wwAPI :: GetTempPath
***********************
*** Function: Returns the OS temporary files path
*** Return: Temp file path with trailing "\"
************************************************************************
LOCAL lcPath, lnResult
*** API Definition:
*** ---------------
*** DWORD GetTempPath(cchBuffer, lpszTempPath)
***
*** DWORD cchBuffer; /* size, in characters, of the buffer */
*** LPTSTR lpszTempPath; /* address of buffer for temp. path name */
DECLARE INTEGER GetTempPath ;
IN WIN32API AS GetTPath ;
INTEGER nBufSize, ;
STRING @cPathName
lcPath=SPACE(256)
lnSize=LEN(lcPath)
lnResult=GetTPath(lnSize,@lcPath)
IF lnResult=0
lcPath=""
ELSE
lcPath=SUBSTR(lcPath,1,lnResult)
ENDIF
RETURN lcPath
ENDFUNC
* eop GetTempPath
FUNCTION GetEXEFile
************************************************************************
* wwAPI :: GetEXEFileName
*********************************
*** Function: Returns the Module name of the EXE file that started
*** the current application. Unlike Application.Filename
*** this function correctly returns the name of the EXE file
*** for Automation servers too!
*** Return: Filename or "" (VFP.EXE is returned in Dev Version)
************************************************************************
DECLARE integer GetModuleFileName ;
IN WIN32API ;
integer hinst,;
string @lpszFilename,;
integer @cbFileName
lcFilename=space(256)
lnBytes=255
=GetModuleFileName(0,@lcFileName,@lnBytes)
lnBytes=AT(CHR(0),lcFileName)
IF lnBytes > 1
lcFileName=SUBSTR(lcFileName,1,lnBytes-1)
ELSE
lcFileName=""
ENDIF
RETURN lcFileName
ENDFUNC
* GetEXEFileName
************************************************************************
* WinApi :: ShellExecute
*********************************
*** Author: Rick Strahl, West Wind Technologies
*** http://www.west-wind.com/
*** Function: Opens a file in the application that it's
*** associated with.
*** Pass: lcFileName - Name of the file to open
*** lcWorkDir - Working directory
*** lcOperation -
*** Return: 2 - Bad Association (invalid URL)
*** 31 - No application association
*** 29 - Failure to load application
*** 30 - Application is busy
***
*** Values over 32 indicate success
*** and return an instance handle for
*** the application started (the browser)
************************************************************************
*** FUNCTION ShellExecute
*** LPARAMETERS lcFileName, lcWorkDir, lcOperation
***
*** lcWorkDir=IIF(type("lcWorkDir")="C",lcWorkDir,"")
*** lcOperation=IIF(type("lcOperation")="C",lcOperation,"Open")
***
*** DECLARE INTEGER ShellExecute ;
*** IN SHELL32.DLL ;
*** INTEGER nWinHandle,;
*** STRING cOperation,;
*** STRING cFileName,;
*** STRING cParameters,;
*** STRING cDirectory,;
*** INTEGER nShowWindow
***
*** RETURN ShellExecute(0,lcOperation,lcFilename,"",lcWorkDir,1)
*** ENDFUNC
*** * ShellExecute
************************************************************************
* wwAPI :: CopyFile
*********************************
*** Function: Copies File. Faster than Fox Copy and handles
*** errors internally.
*** Pass: tcSource - Source File
*** tcTarget - Target File
*** tnFlag - 0* override, 1 don't
*** Return: .T. or .F.
************************************************************************
FUNCTION CopyFile
LPARAMETERS lcSource, lcTarget,nFlag
LOCAL lnRetVal
*** Copy File and overwrite
nFlag=IIF(type("nFlag")="N",nFlag,0)
DECLARE INTEGER CopyFile ;
IN WIN32API ;
STRING @cSource,;
STRING @cTarget,;
INTEGER nFlag
lnRetVal=CopyFile(@lcSource,@lcTarget,nFlag)
RETURN IIF(lnRetVal=0,.F.,.T.)
ENDPROC
* CopyFile
FUNCTION GetUserName
DECLARE INTEGER GetUserName ;
IN WIN32API ;
STRING@ cComputerName,;
INTEGER@ nSize
lcComputer=SPACE(80)
lnSize=80
=GetUserName(@lcComputer,@lnSize)
IF lnSize < 2
RETURN ""
ENDIF
RETURN SUBSTR(lcComputer,1,lnSize-1)
FUNCTION GetComputerName
************************************************************************
* wwAPI :: GetComputerName
*********************************
*** Function: Returns the name of the current machine
*** Return: Name of the computer
************************************************************************
DECLARE INTEGER GetComputerName ;
IN WIN32API ;
STRING@ cComputerName,;
INTEGER@ nSize
lcComputer=SPACE(80)
lnSize=80
=GetComputername(@lcComputer,@lnSize)
IF lnSize < 2
RETURN ""
ENDIF
RETURN SUBSTR(lcComputer,1,lnSize)
ENDFUNC
* GetComputerName
FUNCTION LogonUser
************************************************************************
* wwAPI :: LogonUser
*********************************
*** Function: Check whether a username and password is valid
*** Assume: Account checking must have admin rights
*** Pass: Username, Password and optionally a server
*** Return: .T. or .F.
************************************************************************
LPARAMETERS lcUsername, lcPassword, lcServer
IF EMPTY(lcUsername)
RETURN .F.
ENDIF
IF EMPTY(lcPassword)
lcPassword = ""
ENDIF
IF EMPTY(lcServer)
lcServer = "."
ENDIF
#define LOGON32_LOGON_INTERACTIVE 2
#define LOGON32_LOGON_NETWORK 3
#define LOGON32_LOGON_BATCH 4
#define LOGON32_LOGON_SERVICE 5
#define LOGON32_PROVIDER_DEFAULT 0
DECLARE INTEGER LogonUser in WIN32API ;
String lcUser,;
String lcServer,;
String lcPassword,;
INTEGER dwLogonType,;
Integer dwProvider,;
Integer @dwToken
lnToken = 0
lnResult = LogonUser(lcUsername,lcServer,lcPassword,;
LOGON32_LOGON_NETWORK,LOGON32_PROVIDER_DEFAULT,@lnToken)
DECLARE INTEGER CloseHandle IN WIN32API INTEGER
CloseHandle(lnToken)
RETURN IIF(lnResult=1,.T.,.F.)
ENDFUNC
* wwAPI :: LogonUser
FUNCTION GetSystemDir
************************************************************************
* wwAPI :: GetSystemDir
*********************************
*** Function: Returns the Windows System directory path
*** Pass: llWindowsDir - Optional: Retrieve the Windows dir
*** Return: Windows System directory or "" if failed
************************************************************************
LPARAMETER llWindowsDir
LOCAL lcPath, lnSize
lcPath=SPACE(256)
IF !llWindowsDir
DECLARE INTEGER GetSystemDirectory ;
IN Win32API ;
STRING @pszSysPath,;
INTEGER cchSysPath
lnsize=GetSystemDirectory(@lcPath,256)
ELSE
DECLARE INTEGER GetWindowsDirectory ;
IN Win32API ;
STRING @pszSysPath,;
INTEGER cchSysPath
lnsize=GetWindowsDirectory(@lcPath,256)
ENDIF
if lnSize > 0
RETURN SUBSTR(lcPath,1,lnSize) + "\"
ENDIF
RETURN ""
ENDFUNC
* GetSystemDir
FUNCTION GetCurrentThread
************************************************************************
* wwAPI :: GetCurrentThread
*********************************
*** Function: Returns handle to the current Process/Thread
*** Return: Process Handle or 0
************************************************************************
RETURN GetCurrentThread()
ENDFUNC
* GetProcess
************************************************************************
* wwAPI :: GetThreadPriority
*********************************
*** Function: Gets the current Priority setting of the thread.
*** Use to save and reset priority when bumping it up.
*** Pass: tnThreadHandle
************************************************************************
FUNCTION GetThreadPriority
LPARAMETER tnThreadHandle
RETURN GetThreadPriority(tnThreadHandle)
ENDFUNC
* GetThreadPriority
FUNCTION SetThreadPriority
************************************************************************
* wwAPI :: SetThreadPriority
*********************************
*** Function: Sets a thread process priority. Can dramatically
*** increase performance of a task.
*** Pass: tnThreadHandle
*** tnPriority 0 - Normal
*** 1 - Above Normal
*** 2 - Highest Priority
*** 15 - Time Critical
*** 31 - Real Time (doesn't work w/ Win95)
************************************************************************
LPARAMETER tnThreadHandle,tnPriority
RETURN SetThreadPriority(tnThreadHandle,tnPriority)
ENDFUNC
* GetThreadPriority
FUNCTION PlayWave
************************************************************************
* wwapi :: PlayWave
*******************
*** Class: WinAPI
*** Function: Plays the Wave File or WIN.INI
*** [Sounds] Entry specified in the
*** parameter. If the .WAV file or
*** System Sound can't be found,
*** SystemDefault beep is played
*** Assume: Runs only under Windows
*** uses MMSYSTEM.DLL (Win 3.1)
*** WINMM.DLL (32 bit Win)
*** Pass: pcWaveFile - Full path of Wave file
*** or System Sound Entry
*** pnPlayType - 1 - sound plays in background (default)
*** 0 - sound plays - app waits
*** 2 - No default sound if file doesn't exist
*** 4 - Kill currently playing sound
*** 8 - Continous
*** Values can be added together for combinations
*** Examples:
*** do PlayWav with "SystemQuestion"
*** do PlayWav with "C:\Windows\System\Ding.wav"
*** if PlayWav("SystemAsterisk")
***
*** Return: .t. if Wave was played .f. otherwise
*************************************************************************
LPARAMETER pcWaveFile,pnPlayType
LOCAL lhPlaySnd,llRetVal
pnPlayType=IIF(TYPE("pnPlayType")="N",pnPlayType,1)
llRetVal=.f.
DECLARE INTEGER PlaySound ;
IN WINMM.dll ;
STRING cWave, INTEGER nModule, INTEGER nType
IF PlaySound(pcWaveFile,0,pnPlayType)=1
llRetVal=.t.
ENDIF
RETURN llRetVal
ENDFUNC
*EOF PLAYWAV
FUNCTION CreateGUID
************************************************************************
* wwapi::CreateGUID
********************
*** Author: Rick Strahl, West Wind Technologies
*** http://www.west-wind.com/
*** Modified: 01/26/98
*** Function: Creates a globally unique identifier using Win32
*** COM services. The vlaue is guaranteed to be unique
*** Format: {9F47F480-9641-11D1-A3D0-00600889F23B}
*** Return: GUID as a string or "" if the function failed
*************************************************************************
LPARAMETERS llRaw
LOCAL lcStruc_GUID, lcGUID, lnSize
DECLARE INTEGER CoCreateGuid ;
IN Ole32.dll ;
STRING @lcGUIDStruc
DECLARE INTEGER StringFromGUID2 ;
IN Ole32.dll ;
STRING cGUIDStruc, ;
STRING @cGUID, ;
LONG nSize
*** Simulate GUID strcuture with a string
lcStruc_GUID = REPLICATE(" ",16)
lcGUID = REPLICATE(" ",80)
lnSize = LEN(lcGUID) / 2
IF CoCreateGuid(@lcStruc_GUID) # 0
RETURN ""
ENDIF
IF llRaw
RETURN lcStruc_GUID
ENDIF
*** Now convert the structure to the GUID string
IF StringFromGUID2(lcStruc_GUID,@lcGuid,lnSize) = 0
RETURN ""
ENDIF
*** String is UniCode so we must convert to ANSI
RETURN StrConv(LEFT(lcGUID,76),6)
* Eof CreateGUID
FUNCTION Sleep(lnMilliSecs)
************************************************************************
* wwAPI :: Sleep
*********************************
*** Function: Puts the computer into idle state. More efficient and
*** no keyboard interface than Inkey()
*** Pass: tnMilliseconds
*** Return: nothing
************************************************************************
lnMillisecs=IIF(type("lnMillisecs")="N",lnMillisecs,0)
DECLARE Sleep ;
IN WIN32API ;
INTEGER nMillisecs
=Sleep(lnMilliSecs)
ENDFUNC
* Sleep
************************************************************************
* wwAPI :: GetLastError
*********************************
*** Function:
*** Assume:
*** Pass:
*** Return:
************************************************************************
FUNCTION GetLastError
DECLARE INTEGER GetLastError IN Win32API
RETURN GetLastError()
ENDFUNC
* wwAPI :: GetLastError
************************************************************************
* wwAPI :: GetSystemErrorMsg
*********************************
*** Function: Returns the Message text for a Win32API error code.
*** Pass: lnErrorNo - WIN32 Error Code
*** Return: Error Message or "" if not found
************************************************************************
FUNCTION GetSystemErrorMsg
LPARAMETERS lnErrorNo,lcDLL
LOCAL szMsgBuffer,lnSize
szMsgBuffer=SPACE(500)
DECLARE INTEGER FormatMessage ;
IN WIN32API ;
INTEGER dwFlags ,;
STRING lpvSource,;
INTEGER dwMsgId,;
INTEGER dwLangId,;
STRING @lpBuffer,;
INTEGER nSize,;
INTEGER Arguments
lnSize=FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,0,lnErrorNo,;
0,@szMsgBuffer,LEN(szMsgBuffer),0)
IF LEN(szMsgBUffer) > 1
szMsgBuffer=SUBSTR(szMsgBuffer,1, lnSize-1 )
ELSE
szMsgBuffer=""
ENDIF
RETURN szMsgBuffer
#IF .F. &&!DEBUGMODE
************************************************************************
* wwAPI :: Error
*********************************
*** Function: Sets an Error number of the error occurred
************************************************************************
FUNCTION Error
LPARAMETERS nError, cMethod, nLine
THIS.nLastError=nError
ENDFUNC
* Error
#ENDIF
ENDDEFINE
*EOC wwAPI
************************************************************************
FUNCTION GetTimeZone
*********************************
*** Function: Returns the TimeZone offset from GMT including
*** daylight savings. Result is returned in minutes.
************************************************************************
DECLARE integer GetTimeZoneInformation IN Win32API ;
STRING @ TimeZoneStruct
lcTZ = SPACE(256)
lnDayLightSavings = GetTimeZoneInformation(@lcTZ)
lnOffset = CharToBin(SUBSTR(lcTZ,1,4))
*** Subtract an hour if daylight savings is active
IF lnDaylightSavings = 2
lnOffset = lnOffset - 60
ENDIF
RETURN lnOffSet
**** Binary Numeric conversion routines!
*** Converts DWORD string to binary unsigned integer
FUNCTION CharToBin(tcWord)
LOCAL i, lnWord
lnWord = 0
FOR i = 1 TO LEN(tcWord)
lnWord = lnWord + (ASC(SUBSTR(tcWord, i, 1)) * (2 ^ (8 * (i - 1))))
ENDFOR
RETURN lnWord

Binary file not shown.

File diff suppressed because it is too large Load Diff