Import initial din SVN ROAAUTO/Trunk @HEAD
This commit is contained in:
BIN
COMUN/utile/web/_webview.vct
Normal file
BIN
COMUN/utile/web/_webview.vct
Normal file
Binary file not shown.
BIN
COMUN/utile/web/_webview.vcx
Normal file
BIN
COMUN/utile/web/_webview.vcx
Normal file
Binary file not shown.
293
COMUN/utile/web/htmlmerge.prg
Normal file
293
COMUN/utile/web/htmlmerge.prg
Normal file
@@ -0,0 +1,293 @@
|
||||
* Program....: HtmlMerge.prg
|
||||
* Version....: 1.1
|
||||
* Author.....: Maurice de Beijer
|
||||
* Date.......: September 1, 1999
|
||||
* Notice.....: Copyright (c) 1999-2000 ABL, All Rights Reserved.
|
||||
* Compiler...: Visual FoxPro 06.00.8492.00 for Windows
|
||||
* Abstract...: Merge a HTML template with the current cursor
|
||||
* Changes....:
|
||||
* Useage.....:
|
||||
*
|
||||
* SELECT *, ;
|
||||
* '<A HREF="http://localhost/default.htm">' + eng_name + '</A>' AS Link ;
|
||||
* FROM (ADDBS(_SAMPLES) + 'Data\Products') ;
|
||||
* WHERE !Discontinu ;
|
||||
* ORDER BY Eng_Name ;
|
||||
* INTO CURSOR cProd NOFILTER
|
||||
* * Create the HTML merge object
|
||||
* loHTML = NewObject('HTMLMerge', 'HTMLMerge.prg')
|
||||
* * Read the first template
|
||||
* lcText = FILETOSTR('Template_1.htm')
|
||||
* * Merge it with the cursor of products
|
||||
* loHTML.ScanMerge(lcText)
|
||||
* * Save the result as Demo_1.htm
|
||||
* STRTOFILE(loHTML.cHTML, 'demo_1.htm')
|
||||
*
|
||||
* Note.......:
|
||||
*
|
||||
* May 17, 2000
|
||||
* Add the check for NoScan atributes.
|
||||
* If a table or list containes a NoScan attribute this will be ignored when determining the table/list to scan.
|
||||
* This is usefull when you use a table to format a page header and use a second table below this which
|
||||
* you want to scan. To use it just add a NoScan attribute to any table/list above the table/list you want to
|
||||
* use in the scan loop.
|
||||
|
||||
|
||||
********************************
|
||||
DEFINE CLASS HTMLMerge AS Custom
|
||||
********************************
|
||||
|
||||
* The final HTML Text
|
||||
cHTML = ''
|
||||
|
||||
|
||||
*******************************
|
||||
PROCEDURE ScanMerge(tcTemplate)
|
||||
*******************************
|
||||
* Look for the first table or list in the template
|
||||
* The first item is merged with every line in the current cursor
|
||||
LOCAL lnTable, lnList, lnFirst
|
||||
|
||||
lnTable = THIS.GetScanTagPos('<TABLE', tcTemplate)
|
||||
IF lnTable = 0
|
||||
* No table found
|
||||
lnTable = 99999999
|
||||
ENDIF
|
||||
|
||||
lnList = THIS.GetScanTagPos('<OL', tcTemplate)
|
||||
IF lnList = 0
|
||||
* No numbered list found, check for an bullet list
|
||||
lnList = THIS.GetScanTagPos('<UL', tcTemplate)
|
||||
IF lnList = 0
|
||||
* No list found at all
|
||||
lnList = 99999999
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
IF lnTable < lnList
|
||||
* Table found before any list
|
||||
THIS.MergeTable(tcTemplate, lnTable)
|
||||
ELSE
|
||||
* List found before any table
|
||||
THIS.MergeList(tcTemplate, lnList)
|
||||
ENDIF
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
********************************************
|
||||
PROCEDURE MergeTable(tcTemplate, tnStartPos)
|
||||
********************************************
|
||||
* Merge the body of a HTML table with every record
|
||||
* in the current cursor
|
||||
LOCAL lcTemplate, lnAtPos, lcTable, lcText
|
||||
lcTemplate = tcTemplate
|
||||
IF VARTYPE(tcStartPos) = 'N'
|
||||
* Start position laready known
|
||||
lnAtPos = tnStartPos
|
||||
ELSE
|
||||
* Start position not known yet, find it
|
||||
lnAtPos = THIS.GetScanTagPos('<TABLE', lcTemplate)
|
||||
ENDIF
|
||||
|
||||
* Is there a table ?
|
||||
IF lnAtPos > 0
|
||||
* Table found, first do the header
|
||||
lcText = LEFT(lcTemplate, lnAtPos - 1)
|
||||
lcTemplate = SUBSTR(lcTemplate, lnAtPos)
|
||||
THIS.Merge(lcText)
|
||||
|
||||
* Extract the whole table part stopping just
|
||||
* before the end table marker
|
||||
lnAtPos = ATCC('</TABLE>', lcTemplate)
|
||||
lcTable = LEFT(lcTemplate, lnAtPos - 1)
|
||||
lcTemplate = SUBSTR(lcTemplate, lnAtPos)
|
||||
|
||||
lnAtPos = ATCC('<TR', lcTable)
|
||||
IF lnAtPos > 0
|
||||
* Take care of the starting <TABLE ... > tag
|
||||
lcText = LEFT(lcTable, lnAtPos - 1)
|
||||
lcTable = SUBSTR(lcTable, lnAtPos)
|
||||
THIS.Merge(lcText)
|
||||
ENDIF
|
||||
|
||||
DO WHILE ATCC('<TH', lcTable) > 0
|
||||
* Extract the headers and merger them
|
||||
lnAtPos = ATCC('</TR>', lcTable)
|
||||
lcText = LEFT(lcTable, lnAtPos + 5)
|
||||
lcTable = SUBSTR(lcTable, lnAtPos + 5)
|
||||
THIS.Merge(lcText)
|
||||
ENDDO
|
||||
|
||||
SCAN
|
||||
* Merge the remainig body of the table for each record
|
||||
THIS.Merge(lcTable)
|
||||
ENDSCAN
|
||||
ENDIF
|
||||
|
||||
* Expand the remainder of the template
|
||||
THIS.Merge(lcTemplate)
|
||||
|
||||
RETURN THIS.cHTML
|
||||
|
||||
|
||||
*******************************************
|
||||
PROCEDURE MergeList(tcTemplate, tnStartPos)
|
||||
*******************************************
|
||||
LOCAL lcTemplate, lnAtPos, lcTable, lcText
|
||||
lcTemplate = tcTemplate
|
||||
IF VARTYPE(tcStartPos) = 'N'
|
||||
* Start position laready known
|
||||
lnAtPos = tnStartPos
|
||||
ELSE
|
||||
* Start position not known yet, find it
|
||||
lnAtPos = THIS.GetScanTagPos('<OL', lcTemplate)
|
||||
IF lnAtPos = 0
|
||||
lnAtPos = THIS.GetScanTagPos('<UL', lcTemplate)
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
* Is there a list ?
|
||||
IF lnAtPos > 0
|
||||
* Table found, first do the header
|
||||
lcText = LEFT(lcTemplate, lnAtPos - 1)
|
||||
lcTemplate = SUBSTR(lcTemplate, lnAtPos)
|
||||
THIS.Merge(lcText)
|
||||
|
||||
* Extract the whole table part
|
||||
lnAtPos = ATCC('</OL>', lcTemplate)
|
||||
IF lnAtPos = 0
|
||||
lnAtPos = ATCC('</UL>', lcTemplate)
|
||||
ENDIF
|
||||
lcTable = LEFT(lcTemplate, lnAtPos - 1)
|
||||
lcTemplate = SUBSTR(lcTemplate, lnAtPos)
|
||||
|
||||
lnAtPos = ATCC('<LI', lcTable)
|
||||
IF lnAtPos > 0
|
||||
* Take care of the <TABLE> tag
|
||||
lcText = LEFT(lcTable, lnAtPos - 1)
|
||||
lcTable = SUBSTR(lcTable, lnAtPos)
|
||||
THIS.Merge(lcText)
|
||||
ENDIF
|
||||
|
||||
SCAN
|
||||
* Merge the body for each record
|
||||
THIS.Merge(lcTable)
|
||||
ENDSCAN
|
||||
ENDIF
|
||||
|
||||
* Expand the remainder of the template
|
||||
THIS.Merge(lcTemplate)
|
||||
|
||||
RETURN THIS.cHTML
|
||||
|
||||
|
||||
*************************
|
||||
PROCEDURE Write(tcString)
|
||||
*************************
|
||||
* Add a string to the output
|
||||
|
||||
THIS.cHTML = THIS.cHTML + TRANSFORM(tcString)
|
||||
|
||||
RETURN
|
||||
|
||||
*************************
|
||||
PROCEDURE WriteLine(tcString)
|
||||
*************************
|
||||
* Add a string and new line to the output
|
||||
|
||||
* Write the line
|
||||
THIS.Write(tcString)
|
||||
* Write the cariage return
|
||||
THIS.Write(CHR(13)+CHR(10))
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
*****************
|
||||
PROCEDURE Clear()
|
||||
*****************
|
||||
* Clear all output
|
||||
|
||||
THIS.cHTML = ''
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
***********************
|
||||
PROCEDURE Merge(tcText)
|
||||
***********************
|
||||
* Merge a template with the embedded Visual FoxPro expressions
|
||||
LOCAL lcText, lnAtPos1, lnAtPos2, lcEval, lcValue
|
||||
LOCAL loEx as exception
|
||||
lcText = tcText
|
||||
lcText = STRTRAN(lcText, '<%', '<%')
|
||||
lcText = STRTRAN(lcText, '%>', '%>')
|
||||
|
||||
* Loop while another expression is found
|
||||
DO WHILE ATCC('<%=', lcText) > 0
|
||||
* Get the start and end position of the next expression
|
||||
lnAtPos1 = ATCC('<%=', lcText)
|
||||
lnAtPos2 = ATCC('%>', lcText)
|
||||
|
||||
* Extract the next expression
|
||||
lcEval = SUBSTR(lcText, lnAtPos1 + 3, lnAtPos2 - lnAtPos1 - 3)
|
||||
* Remove any cariage returns from the expression as they could be inserted by an HTML editor
|
||||
lcEval = CHRTRAN(lcEval, CHR(13) + CHR(10), '')
|
||||
|
||||
* Evaluate it
|
||||
lcValue = ''
|
||||
TRY
|
||||
lcValue = TRANSFORM(EVALUATE(lcEval))
|
||||
CATCH TO loEx
|
||||
AMESSAGEBOX(ALLTRIM(STR(loEx.ErrorNo)) + ' ' + loEx.Message + CHR(13) + CHR(10) + TRANSFORM(m.lcEval),0+16, _screen.Caption)
|
||||
ENDTRY
|
||||
* Stuff the result back instead of the original expression
|
||||
lcText = STUFFC(lcText, lnAtPos1, lnAtPos2 - lnAtPos1 + 2, lcValue)
|
||||
ENDDO
|
||||
|
||||
* Add it to the current HTML
|
||||
THIS.Write(lcText)
|
||||
|
||||
* Return the result
|
||||
RETURN lcText
|
||||
|
||||
|
||||
******************************************
|
||||
PROCEDURE GetScanTagPos(tcTag, tcTemplate)
|
||||
******************************************
|
||||
* Find the required scan tag, ignore all tags containing a NoScan attribute
|
||||
LOCAL lnResult, lnPos, lnAtPos1, lnAtPos2, lcTemp
|
||||
lnResult = 0
|
||||
lnPos = 1
|
||||
|
||||
DO WHILE .T.
|
||||
* Find the next position
|
||||
lnAtPos1 = ATCC(tcTag, tcTemplate, lnPos)
|
||||
IF lnAtPos1 > 0
|
||||
* Found another tag to test, extract the rest of the string
|
||||
lcTemp = SUBSTR(tcTemplate, lnAtPos1)
|
||||
* Find the end of the tag
|
||||
lnAtPos2 = ATCC('>', lcTemp)
|
||||
* And determine the complete tag
|
||||
lcTemp = LEFT(lcTemp, lnAtPos2)
|
||||
|
||||
* Check if we are to ignore this tag during the scan operation
|
||||
IF ATCC('NoScan', lcTemp) = 0
|
||||
* No NoScan attribute on this tag, use it
|
||||
lnResult = lnAtPos1
|
||||
EXIT
|
||||
ELSE
|
||||
* Try to find a next tag
|
||||
lnPos = lnPos + 1
|
||||
ENDIF
|
||||
ELSE
|
||||
* Didn't find the required tag, stop
|
||||
EXIT
|
||||
ENDIF
|
||||
ENDDO
|
||||
|
||||
|
||||
RETURN lnResult
|
||||
|
||||
ENDDEFINE
|
||||
263
COMUN/utile/web/wconnect.h
Normal file
263
COMUN/utile/web/wconnect.h
Normal 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.
|
||||
|
||||
359
COMUN/utile/web/wwConfig.PRG
Normal file
359
COMUN/utile/web/wwConfig.PRG
Normal file
@@ -0,0 +1,359 @@
|
||||
#INCLUDE WCONNECT.h
|
||||
|
||||
SET PROCEDURE TO wwConfig ADDITIVE
|
||||
|
||||
*** Dependencies
|
||||
SET CLASSLIB TO wwXML ADDITIVE
|
||||
SET PROCEDURE TO wwAPI ADDITIVE
|
||||
SET PROCEDURE TO wwUtils ADDITIVE
|
||||
|
||||
*!* #IF .F.
|
||||
*!* *** Test/demo code
|
||||
*!* CLEAR
|
||||
*!* o=create("MyConfig")
|
||||
*!* o.cFileName = "Config.xml"
|
||||
*!* o.cMode = "XML"
|
||||
|
||||
*!* IF .F.
|
||||
*!* o.cFileName = "Config.ini"
|
||||
*!* o.cAppName = "Ini File Test"
|
||||
*!* ? o.Save()
|
||||
*!* ENDIF
|
||||
*!* IF .F.
|
||||
*!* o.cFileName = "Config.ini"
|
||||
*!* ? o.LoadIni()
|
||||
*!* ? o.cAppName
|
||||
*!* ? o.oTest.cHTMLPagePath
|
||||
*!* ENDIF
|
||||
*!* IF .F.
|
||||
*!* o.cAppName = "Default Application - Not yet set"
|
||||
*!* o.nTimerInterval = 100
|
||||
*!* o.cTemplate="cfg_"
|
||||
*!* ? o.Save()
|
||||
*!* modi comm config.xml
|
||||
*!* ENDIF
|
||||
*!* IF .F.
|
||||
*!* o.Load()
|
||||
*!* ENDIF
|
||||
|
||||
*!* IF .F.
|
||||
*!* o.cAppName = "Test Application"
|
||||
*!* o.nTimerInterval = 100
|
||||
|
||||
*!* o.cRegPath = "Software\West Wind Technologies\TestConfig"
|
||||
*!* o.cRegNode = "Parameters"
|
||||
*!* ? o.SaveRegistry()
|
||||
*!* ENDIF
|
||||
*!* IF .F.
|
||||
*!* o.cRegPath = "Software\West Wind Technologies\TestConfig"
|
||||
*!* o.cRegNode = "Parameters"
|
||||
*!*
|
||||
*!* ? o.LoadRegistry()
|
||||
*!* ENDIF
|
||||
|
||||
*!* ? o.cAppName
|
||||
*!* ? o.nTimerInterval
|
||||
*!* ? o.cTemplate
|
||||
|
||||
*!* RETURN
|
||||
|
||||
*!* *** All you have to do is add properties
|
||||
*!* *** for the config items and type them properly
|
||||
*!* *** with default values for first startup
|
||||
*!* DEFINE CLASS MyConfig AS wwConfig
|
||||
*!* cPath="d:\temp\"
|
||||
*!* cTemplate="wc_"
|
||||
*!* nPriority=1
|
||||
*!* lDebugMode=.F.
|
||||
*!* lLogToFile=.T.
|
||||
*!* lShowStatus=.T.
|
||||
*!* nScriptMode=3
|
||||
*!* nTimerInterval=250
|
||||
*!* lSaveRequestFiles=.F.
|
||||
*!* cAppName = ""
|
||||
*!* oTest = .NULL.
|
||||
*!* FUNCTION Init
|
||||
*!* *THIS.oTest = CREATE("cTest")
|
||||
*!* *THIS.oTest.cHTMLPagePath = "d:\westwind\wconnect\"
|
||||
*!* RETURN
|
||||
*!* ENDFUNC
|
||||
*!* ENDDEFINE
|
||||
|
||||
*!* DEFINE CLASS cTest as Relation
|
||||
*!* cHTMLPagePath = "Test Path"
|
||||
*!* *cDataPath = "d:\westwind\data"
|
||||
*!* ENDDEFINE
|
||||
*!* #ENDIF
|
||||
*************************************************************
|
||||
DEFINE CLASS wwConfig AS Relation
|
||||
*************************************************************
|
||||
|
||||
*** These values are not part of the XML exported
|
||||
*** interface.
|
||||
cFileName = ""
|
||||
cSubName = "config"
|
||||
oXML = .NULL.
|
||||
cRegPath = "SOFTWARE\West Wind Technologies\Config"
|
||||
cRegNode = "Parameters"
|
||||
cMode = "INI"
|
||||
|
||||
PROTECTED cPropertyExclusionList
|
||||
cPropertyExclusionList = ",cfilename,oxml,cregpath,cregnode,"+;
|
||||
"csubname,cmode,cpropertyexclusionlist,loverwriteini"
|
||||
|
||||
|
||||
****************************************************************
|
||||
FUNCTION Save
|
||||
*************
|
||||
LPARAMETER loObject
|
||||
|
||||
THIS.cMode = UPPER(THIS.cMode)
|
||||
|
||||
DO CASE
|
||||
CASE THIS.cMode = "XML"
|
||||
IF EMPTY(THIS.cFileName)
|
||||
RETURN .F.
|
||||
ENDIF
|
||||
|
||||
STRTOFILE(THIS.CreateXML(),THIS.cFileName)
|
||||
CASE THIS.cMode = "INI"
|
||||
IF EMPTY(THIS.cFileName)
|
||||
RETURN .F.
|
||||
ENDIF
|
||||
*ERASE (FULLPATH(THIS.cFileName))
|
||||
THIS.SaveIni(this)
|
||||
CASE THIS.cMode = "REGISTRY"
|
||||
THIS.SaveRegistry()
|
||||
ENDCASE
|
||||
|
||||
RETURN .T.
|
||||
|
||||
****************************************************************
|
||||
FUNCTION Load
|
||||
*************
|
||||
LPARAMETER loOBject
|
||||
|
||||
THIS.cMode = UPPER(THIS.cMode)
|
||||
|
||||
DO CASE
|
||||
CASE THIS.cMode = "XML"
|
||||
IF EMPTY(THIS.cFileName) or !FILE(THIS.cFileName)
|
||||
RETURN .F.
|
||||
ENDIF
|
||||
|
||||
lcXML = FILETOSTR(THIS.cFileName)
|
||||
THIS.LoadFromXML(lcXML)
|
||||
CASE THIS.cMode = "INI"
|
||||
RETURN THIS.LoadIni(loObject)
|
||||
CASE THIS.cMode = "REGISTRY"
|
||||
RETURN THIS.LOADREGISTRY()
|
||||
ENDCASE
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
****************************************************************
|
||||
FUNCTION SaveRegistry
|
||||
*********************
|
||||
loAPi = CREATE("wwAPI")
|
||||
|
||||
lcXML = THIS.CreateXML()
|
||||
|
||||
RETURN loAPI.WriteRegistryString(,THIS.cRegPath,THIS.cRegNode,lcXML,.T.)
|
||||
|
||||
|
||||
****************************************************************
|
||||
FUNCTION LoadRegistry
|
||||
*********************
|
||||
|
||||
loAPI = CREATE("wwAPI")
|
||||
lcXML = loAPI.ReadRegistryString(,THIS.cRegPath,THIS.cRegNode)
|
||||
IF ISNULL(lcXML)
|
||||
RETURN .F.
|
||||
ENDIF
|
||||
|
||||
RETURN THIS.LoadFromXML(lcXML)
|
||||
|
||||
****************************************************************
|
||||
PROTECTED FUNCTION CreateXML
|
||||
****************************
|
||||
|
||||
loXML = CREATE("wwXML")
|
||||
loXML.lRecurseObjects = .T.
|
||||
loXML.lStripTypePrefix = .T.
|
||||
|
||||
loXML.cDocRootName = lower(JustStem(THIS.cFileName))
|
||||
IF loXML.cDocRootName="config"
|
||||
loXML.cDocRootName = "wwConfig"
|
||||
ENDIF
|
||||
|
||||
*** We have to exclude these internal properties
|
||||
loXML.cPropertyExclusionList = loXML.cPropertyExclusionList + ;
|
||||
THIS.cPropertyExclusionList
|
||||
|
||||
RETURN loXML.ObjectToXML(THIS,THIS.cSubName)
|
||||
|
||||
****************************************************************
|
||||
PROTECTED FUNCTION LoadFromXML
|
||||
******************************
|
||||
LPARAMETER lcXML
|
||||
|
||||
loXML = CREATE("wwXML")
|
||||
loXML.lRecurseObjects = .T.
|
||||
loXML.lStripTypePrefix = .T.
|
||||
|
||||
*** Simply reload the object properties from the XML
|
||||
loXML.XMLToObject(lcXML,THIS)
|
||||
|
||||
RETURN loXML.lError
|
||||
|
||||
****************************************************************
|
||||
FUNCTION SaveIni
|
||||
*********************
|
||||
LPARAMETER loObject, lcName
|
||||
LOCAL lcOutput, lnX, lnCount, laFields(1), lcField, lcType, lvValue, loXML
|
||||
|
||||
loXML = CREATE("wwXML")
|
||||
*** We have to exclude these internal properties
|
||||
loXML.cPropertyExclusionList = loXML.cPropertyExclusionList + ;
|
||||
THIS.cPropertyExclusionList
|
||||
|
||||
lcName=IIF(EMPTY(lcName),THIS.cSubName,lcName)
|
||||
lcFileName = FULLPATH(THIS.cFileName)
|
||||
|
||||
EXTERNAL ARRAY la_array
|
||||
|
||||
IF VARTYPE(loObject)#"O"
|
||||
loObject = THIS
|
||||
ENDIF
|
||||
|
||||
loAPI = CREATE("wwAPI")
|
||||
|
||||
lnCount = AMEMBERS(laFields, loObject)
|
||||
|
||||
FOR lnX=1 TO lnCount
|
||||
lcField = LOWER(laFields[lnX])
|
||||
IF AT("," + lcField + ",", "," + loXML.cPropertyExclusionList + ",")>0
|
||||
LOOP
|
||||
ENDIF
|
||||
lcType = TYPE("loObject."+lcField)
|
||||
lvValue = EVAL("loObject."+lcField)
|
||||
|
||||
IF .T. &&THIS.lStripTypePrefix
|
||||
lcDispField = Proper(SUBSTR(lcField,2))
|
||||
ELSE
|
||||
lcDispField = Proper(lcField)
|
||||
ENDIF
|
||||
|
||||
DO CASE
|
||||
CASE ISNULL(lvValue)
|
||||
loAPI.WriteProfileString(lcFileName,lcName,lcDispField,"NULL")
|
||||
CASE lcType = "C"
|
||||
loAPI.WriteProfileString(lcFileName,lcName,lcDispField,TRIM(lvValue))
|
||||
CASE lcType = "D" OR lcType = "T"
|
||||
loAPI.WriteProfileString(lcFileName,lcName,lcDispField,TRANSFORM(lvValue))
|
||||
CASE lcType = "L"
|
||||
loAPI.WriteProfileString(lcFileName,lcName,lcDispField,IIF(lvValue,"On","Off"))
|
||||
CASE lcType = "O"
|
||||
THIS.SaveIni(loObject.&lcField,lcDispField)
|
||||
CASE lcType = "U"
|
||||
loAPI.WriteProfileString(lcFileName,lcName,lcDispField,"NULL")
|
||||
OTHERWISE
|
||||
loAPI.WriteProfileString(lcFileName,lcName,lcDispField,TRANSFORM(lvValue))
|
||||
ENDCASE
|
||||
ENDFOR
|
||||
|
||||
RETURN .T.
|
||||
|
||||
****************************************************************
|
||||
FUNCTION LoadIni
|
||||
*********************
|
||||
LPARAMETER loObject, lcName
|
||||
LOCAL lcName, lcFileName, loAPI, loXML, lnProperties, lnX,;
|
||||
lcField, lcXMLField, lcType, lcValue, loObject,;
|
||||
laProperties[1]
|
||||
|
||||
IF VARTYPE(loObject) # "O"
|
||||
loObject=THIS
|
||||
ENDIF
|
||||
|
||||
lcName=IIF(EMPTY(lcName),THIS.cSubName,lcName)
|
||||
lcFileName = FULLPATH(THIS.cFileName)
|
||||
|
||||
loAPI = CREATE("wwAPI")
|
||||
loXML = CREATE("wwXML")
|
||||
*** We have to exclude these internal properties
|
||||
loXML.cPropertyExclusionList = loXML.cPropertyExclusionList + ;
|
||||
THIS.cPropertyExclusionList
|
||||
|
||||
*** Walk the object and then pull properties
|
||||
*** from the INI to repopulate it
|
||||
lnProperties = AMEMBERS(laProperties,loObject)
|
||||
|
||||
lnX=0
|
||||
FOR lnX=1 TO lnProperties
|
||||
lcField = lower(laProperties[lnX])
|
||||
if "," + lower(lcField) + "," $ "," + loXML.cPropertyExclusionList + ","
|
||||
LOOP
|
||||
ENDIF
|
||||
|
||||
lcXMLField = SUBSTR(lcField,2)
|
||||
lcType = TYPE("loObject." + lcField)
|
||||
lcValue = loAPI.GetProfileString(lcFileName,lcName,lcXMLField)
|
||||
IF ISNULL(lcValue) AND lcType # "O"
|
||||
LOOP
|
||||
ENDIF
|
||||
|
||||
DO CASE
|
||||
CASE lcType $ "CM"
|
||||
loObject.&lcField = lcValue
|
||||
CASE lcType $ "NIF"
|
||||
loObject.&lcField = VAL(lcValue)
|
||||
CASE lcType = "T"
|
||||
loObject.&lcField = CTOT(lcValue)
|
||||
CASE lcType = "D"
|
||||
loObject.&lcField = CTOD(lcValue)
|
||||
CASE lcType = "L"
|
||||
IF lcValue = "1" or UPPER(lcValue) = "ON"
|
||||
loObject.&lcField = .T.
|
||||
ELSE
|
||||
loObject.&lcField = .F.
|
||||
ENDIF
|
||||
CASE lcType = "O"
|
||||
THIS.LoadIni(loObject.&lcField,lcXMLField)
|
||||
ENDCASE
|
||||
ENDFOR
|
||||
|
||||
RETURN .T.
|
||||
|
||||
|
||||
ENDDEFINE
|
||||
|
||||
|
||||
*** CODE TO CREATE A NEW SUBTREE IN THE HELP HIERARCHY
|
||||
|
||||
*!* loAPI = THIS.oAPI
|
||||
|
||||
*!* this.cSubTree = "SOFTWARE\"+THIS.cCompany+"\"+THIS.cAppName
|
||||
*!* IF VARTYPE(THIS.cVersion) # "C"
|
||||
*!* this.cVersion = TRANS(THIS.cVersion)
|
||||
*!* ENDIF
|
||||
|
||||
*!* lcValue = loAPI.ReadRegistryString(,THIS.cSubTree,"")
|
||||
|
||||
*!* lcValue = loAPI.ReadRegistryString(,"SOFTWARE\"+THIS.cCompany+"\"+THIS.cAppName+"\Parameters","CurrentVersion")
|
||||
*!* IF ISNULL(lcValue)
|
||||
*!* loAPI.WriteRegistryString(,"SOFTWARE\"+THIS.cCompany,"","",.T.)
|
||||
*!* loAPI.WriteRegistryString(,THIS.cSubTree,"","",.T.)
|
||||
*!* loAPI.WriteRegistryString(,THIS.cSubTree+"\Parameters","CurrentVersion",THIS.cVersion,.T.)
|
||||
*!* ELSE
|
||||
*!* *** Update the version if its different
|
||||
*!* IF lcValue # THIS.cVersion
|
||||
*!* loAPI.WriteRegistryString(,THIS.cSubTree+"\Parameters","CurrentVersion",THIS.cVersion,.T.)
|
||||
*!* ENDIF
|
||||
*!* ENDIF
|
||||
|
||||
*!* RETURN
|
||||
|
||||
|
||||
|
||||
1505
COMUN/utile/web/wwHttp.PRG
Normal file
1505
COMUN/utile/web/wwHttp.PRG
Normal file
File diff suppressed because it is too large
Load Diff
1046
COMUN/utile/web/wwapi.PRG
Normal file
1046
COMUN/utile/web/wwapi.PRG
Normal file
File diff suppressed because it is too large
Load Diff
549
COMUN/utile/web/wwcodeupdate.prg
Normal file
549
COMUN/utile/web/wwcodeupdate.prg
Normal file
@@ -0,0 +1,549 @@
|
||||
#INCLUDE WCONNECT.H
|
||||
|
||||
*** The following PRG contains:
|
||||
*** A self loading stub program that can be used to run
|
||||
*** as the code 'hot swapper' after the main EXe has unloaded
|
||||
***
|
||||
*** Following the stub is the actual CodeUpdate class
|
||||
************************************************************************
|
||||
* CodeUpdate
|
||||
****************************************
|
||||
*** Function: Hot swaps an EXE file by running a Zip Exe file that
|
||||
*** unzips the update files.
|
||||
*** Assume: The original application has quit and is no longer
|
||||
*** loaded and running.
|
||||
*** Pass: lcExeFile - The main application EXE file to run
|
||||
*** (wwReader70.exe)
|
||||
*** lcUpdateFile - The updated EXE(Auto-Zip) file (full path)
|
||||
*** that contains the update files
|
||||
*** (d:\temp\updates\wwReaderUpdate.exe)
|
||||
*** Return: nothing
|
||||
************************************************************************
|
||||
LPARAMETER lcExeFile, lcUpdateFile, lcApplicationName
|
||||
|
||||
SET PROCEDURE TO wwCodeUpdate ADDIT
|
||||
SET PROCEDURE TO wwUtils ADDIT
|
||||
SET PROCEDURE TO wwHTTP ADDIT
|
||||
SET CLASSLIB TO wwDialogs ADDIT
|
||||
|
||||
*** Default - just load classes and exit
|
||||
IF EMPTY(lcExeFile)
|
||||
* WAIT WINDOW TIMEOUT 5 "No Exe file specified on command line..."
|
||||
RETURN
|
||||
ENDIF
|
||||
IF EMPTY(lcUpdateFile) OR !FILE(lcUpdateFile)
|
||||
WAIT WINDOW TIMEOUT 5 "Invalid Update File Path specified on command line..."
|
||||
ENDIF
|
||||
|
||||
loVersion = CREATEOBJECT("wwCodeUpdate")
|
||||
loVersion.cExeFile = lcExeFile
|
||||
|
||||
IF !EMPTY(lcApplicationName)
|
||||
loVersion.cApplicationName = lcApplicationName
|
||||
ENDIF
|
||||
|
||||
loVersion.SwapExes(lcUpdateFile)
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
*** Main Application Sample code
|
||||
#IF .F.
|
||||
#DEFINE APP_VERSION 1.0
|
||||
*** Test Code
|
||||
MESSAGEBOX("West Wind Technologies presents:" + CHR(13)+CHR(13) + ;
|
||||
CHR(9) + "GREAT BIG, BAD APPLICATION" + CHR(13) + ;
|
||||
CHR(9) + "Version " + TRANS(APP_VERSION,"99.99") + CHR(13),;
|
||||
64,"West Wind Technologies")
|
||||
|
||||
|
||||
o=CREATEOBJECT("wwCodeUpdate")
|
||||
o.cVersionUrl = "http://localhost/codeupdate/update.xml"
|
||||
o.cVersionType = "N"
|
||||
o.cExeFile = "test.exe"
|
||||
|
||||
lnVersion = o.GetVersionInfo()
|
||||
IF lnVersion > APP_VERSION
|
||||
IF MESSAGEBOX("Version " + TRANS(lnVersion,"99.99") + " of GREAT BIG APP" + CHR(13) +;
|
||||
"is available online now." + CHR(13) + CHR(13) +;
|
||||
"Would you like to download it now?",32+4,;
|
||||
"West Wind Technologies") = 6
|
||||
o.DownloadUpdate()
|
||||
o.UpdateCode("cu_Update.exe")
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
MESSAGEBOX("your Great Big Application starts here")
|
||||
|
||||
RETURN
|
||||
#ENDIF
|
||||
|
||||
*************************************************************
|
||||
DEFINE CLASS wwCodeUpdate AS RELATION
|
||||
*************************************************************
|
||||
*: Author: Rick Strahl
|
||||
*: (c) West Wind Technologies, 2000
|
||||
*:Contact: http://www.west-wind.com
|
||||
*************************************************************
|
||||
#IF .F.
|
||||
*:Help Documentation
|
||||
*:Topic:
|
||||
wwServer::GetProcessID
|
||||
|
||||
*:Description:
|
||||
|
||||
*:Example:
|
||||
|
||||
*:Remarks:
|
||||
SERVER UPDATE FILE looks AS follows:
|
||||
<?XML VERSION="1.0"?>
|
||||
<codeupdate>
|
||||
<VERSION>2.55</VERSION>
|
||||
<minversion>2.45</minversion>
|
||||
<fileurl>http://www.west-WIND.com/FILES/UPDATES/wwhelp_update.EXE</fileurl>
|
||||
<filesize>444</filesize>
|
||||
<commandline>wwhelp.EXE</commandline>
|
||||
</codeupdate>
|
||||
|
||||
The ONLY required KEYS are <VERSION> AND <fileurl> WITH The others optional.
|
||||
|
||||
*:SeeAlso:
|
||||
|
||||
|
||||
*:ENDHELP
|
||||
#ENDIF
|
||||
|
||||
cVersionUrl = ""
|
||||
cVersionType = "C"
|
||||
cExeFile = ""
|
||||
cCommandLineParameters = ""
|
||||
cApplicationName = "the application"
|
||||
cDownloadPath = ".\CodeUpdate\"
|
||||
|
||||
lUnZipFile = .F.
|
||||
cErrorMsg = ""
|
||||
lError = .F.
|
||||
|
||||
*** Downloaded values from XML file
|
||||
vOnlineVersion = ""
|
||||
cOnlineFileUrl = ""
|
||||
nFileSize = 0
|
||||
vOnlineMinVersion = ""
|
||||
cUserMessage = ""
|
||||
cNewsMessage = ""
|
||||
|
||||
lShowDialog = .T.
|
||||
nConnectTimeout = 5000
|
||||
|
||||
*** Allows access configuration of HTTP
|
||||
*** settings. Call CreateHTTPClient to
|
||||
*** create an instance of this object to
|
||||
*** manipulate
|
||||
oHTTP = NULL
|
||||
|
||||
PROTECTED cXML
|
||||
cXML = ""
|
||||
cAppStartpath = ""
|
||||
|
||||
************************************************************************
|
||||
* wwCodeUpdate :: Init
|
||||
*********************************
|
||||
*** Function:
|
||||
*** Assume:
|
||||
*** Pass:
|
||||
*** Return:
|
||||
************************************************************************
|
||||
FUNCTION INIT
|
||||
|
||||
THIS.cAppStartpath = GetAppStartPath()
|
||||
|
||||
ENDFUNC
|
||||
* wwCodeUpdate :: Init
|
||||
|
||||
************************************************************************
|
||||
* wwCodeUpdate :: GetVersionInfo
|
||||
*********************************
|
||||
*** Function: Retrieves online XML file and parses the Version and
|
||||
*** download URL from the result
|
||||
*** Assume: Sets these properties from XML retrieved:
|
||||
*** vOnlineVersion
|
||||
*** cOnlineFileUrl
|
||||
*** Pass: lnVersion - Current Version Number/or string
|
||||
*** Return: Numeric: Online Version number or 0 on failure
|
||||
************************************************************************
|
||||
FUNCTION GetVersionInfo
|
||||
LOCAL loIP, lcVersionType, lcXML, lnSize, lcVersion
|
||||
|
||||
THIS.SetError()
|
||||
|
||||
lcVersionType = THIS.cVersionType
|
||||
|
||||
IF ISNULL(THIS.oHTTP)
|
||||
* THIS.CreateHTTPClient()
|
||||
THIS.oHTTP = CREATEOBJECT("cu_wwHTTP")
|
||||
ENDIF
|
||||
|
||||
THIS.oHTTP.lShowDialog = .F.
|
||||
|
||||
lcXML = THIS.oHTTP.HTTPGet(THIS.cVersionUrl)
|
||||
|
||||
IF THIS.oHTTP.nError # 0
|
||||
THIS.SetError(THIS.oHTTP.cErrorMsg)
|
||||
RETURN IIF(lcVersionType = "C","",0)
|
||||
ENDIF
|
||||
|
||||
IF LEFT(lcXML,5) <> "<?xml"
|
||||
THIS.SetError("Missing or invalid XML returned from server")
|
||||
RETURN IIF(lcVersionType = "C","",0)
|
||||
ENDIF
|
||||
|
||||
lcVersion = Extract(lcXML,"<version>","</version>")
|
||||
IF EMPTY(lcVersion)
|
||||
THIS.SetError("No version number found in XML")
|
||||
RETURN IIF(lcVersionType = "C","",0)
|
||||
ENDIF
|
||||
|
||||
THIS.vOnlineVersion = IIF(lcVersionType="C",lcVersion,VAL(lcVersion))
|
||||
|
||||
lcVersion = Extract(lcXML,"<minversion>","</minversion>")
|
||||
IF !EMPTY(lcVersion)
|
||||
THIS.vOnlineMinVersion = IIF(lcVersionType="C",lcVersion,VAL(lcVersion))
|
||||
ENDIF
|
||||
***!!!!!!!!!
|
||||
*---------------------------
|
||||
*THIS.cOnlineFileUrl = Extract(lcXML,"<fileurl>","</fileurl>")
|
||||
THIS.cOnlineFileUrl = JUSTPATH(THIS.cVersionUrl) + "/" + Extract(lcXML,"<fileurl>","</fileurl>")
|
||||
*======================================
|
||||
***!!!!!!!!!!!!!!
|
||||
THIS.nFileSize = VAL( Extract(lcXML,"<filesize>","</filesize>") )
|
||||
THIS.cUserMessage = Extract(lcXML,"<usermessage>","</usermessage>")
|
||||
THIS.cNewsMessage = Extract(lcXML,"<newsmessage>","</newsmessage>")
|
||||
|
||||
*** Save the XML just in case
|
||||
THIS.cXML = lcXML
|
||||
|
||||
*!* IF lcVersionType = "C"
|
||||
*!* RETURN lcVersion
|
||||
*!* ENDIF
|
||||
|
||||
RETURN THIS.vOnlineVersion
|
||||
ENDFUNC
|
||||
* wwCodeUpdate :: GetVersion
|
||||
|
||||
************************************************************************
|
||||
* wwCodeUpdate :: CheckVersionAndUpdate
|
||||
***************************************
|
||||
*** Function:
|
||||
*** Assume:
|
||||
*** Pass:
|
||||
*** Return:
|
||||
************************************************************************
|
||||
FUNCTION CheckVersionAndUpdate
|
||||
LPARAMETERS lvVersion
|
||||
|
||||
lvNewVersion = THIS.GetVersion()
|
||||
|
||||
IF lvNewVersion > lvVersion
|
||||
THIS.DownloadUpdate()
|
||||
THIS.UpdateCode()
|
||||
ENDIF
|
||||
|
||||
ENDFUNC
|
||||
* wwCodeUpdate :: CheckVersionAndUpdate
|
||||
|
||||
************************************************************************
|
||||
* wwCodeUpdate :: DownloadUpdate
|
||||
*********************************
|
||||
*** Function: Downloads the actual file from the Web site.
|
||||
*** Assume:
|
||||
*** Pass: llCheckForExistingVersion
|
||||
*** Return: .T. or .F.
|
||||
************************************************************************
|
||||
FUNCTION DownloadUpdate
|
||||
LPARAMETER llCheckforExistingVersion, tcFileVersionXML
|
||||
LOCAL loIP, lcData, lnSize, loUrl
|
||||
|
||||
IF !EMPTY(tcFileVersionXML)
|
||||
lcFileVersionXML = tcFileVersionXML
|
||||
ELSE
|
||||
lcFileVersionXML = "fileversion.xml"
|
||||
ENDIF
|
||||
|
||||
IF llCheckforExistingVersion
|
||||
lcFile = File2Var(THIS.cDownloadPath + lcFileVersionXML)
|
||||
lcVersion = Extract(lcFile,"<version>","</version>")
|
||||
IF IIF(THIS.cVersionType="C",lcVersion,VAL(lcVersion)) = THIS.vOnlineVersion
|
||||
RETURN .T. && File was already downloaded
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
IF ISNULL(THIS.oHTTP)
|
||||
loIP = THIS.CreateHTTPClient()
|
||||
ELSE
|
||||
loIP = THIS.oHTTP
|
||||
ENDIF
|
||||
|
||||
loIP.lShowDialog = THIS.lShowDialog
|
||||
|
||||
*** Break down the URL into its components
|
||||
loUrl = loIP.InternetCrackUrl(THIS.cOnlineFileUrl)
|
||||
IF ISNULL(loUrl)
|
||||
RETURN .F.
|
||||
ENDIF
|
||||
loIP.nhttpport=VAL(loUrl.cPort)
|
||||
IF loIP.HTTPConnect(loUrl.cServer,"","",IIF(LOWER(loUrl.cProtocol)="https",.T.,.F.)) # 0
|
||||
THIS.SetError(loIP.cErrorMsg)
|
||||
RETURN .F.
|
||||
ENDIF
|
||||
|
||||
*** Create a temporary directory if it doesn't exist
|
||||
IF !ISDIR(THIS.cDownloadPath)
|
||||
MD (THIS.cDownloadPath)
|
||||
ENDIF
|
||||
|
||||
lcTFile = THIS.cDownloadPath + JUSTFNAME(STRTRAN(THIS.cOnlineFileUrl,"/","\"))
|
||||
lcData = ""
|
||||
lnSize = 0
|
||||
|
||||
|
||||
IF loIP.HTTPGetEx( TRIM(loUrl.cPath),@lcData,@lnSize,,lcTFile) # 0
|
||||
THIS.SetError(loIP.cErrorMsg)
|
||||
RETURN .F.
|
||||
ENDIF
|
||||
|
||||
File2Var(THIS.cDownloadPath + lcFileVersionXML,;
|
||||
[<?xml version="1.0"?><version>]+ TRANS(THIS.vOnlineVersion) +[</version>])
|
||||
|
||||
loIP.HTTPClose()
|
||||
|
||||
ENDFUNC
|
||||
* wwCodeUpdate :: DownloadUpdate
|
||||
|
||||
|
||||
************************************************************************
|
||||
* wwCodeUpdate :: SwapExes
|
||||
****************************************
|
||||
*** Function: Hot swaps an EXE file by running a Zip Exe file that
|
||||
*** unzips the update files.
|
||||
*** Assume: The original application has quit and is no longer
|
||||
*** loaded and running.
|
||||
*** Meant to be run as a mainline method
|
||||
*** Pass: lcUpdateFile - The updated EXE(Auto-Zip) file (full path)
|
||||
*** that contains the update files
|
||||
*** Return: nothing
|
||||
************************************************************************
|
||||
FUNCTION SwapExes
|
||||
LPARAMETER lcUpdateFile
|
||||
LOCAL loSafety, OP
|
||||
|
||||
loSafety = CREATEOBJECT("wwEnv","SAFETY","OFF")
|
||||
|
||||
*_screen.visible = .F.
|
||||
|
||||
IF EMPTY(lcUpdateFile)
|
||||
lcUpdateFile = SYS(5) + CURDIR() + [\codeupdate\Codeupdate.exe /auto ] +;
|
||||
SYS(5) + CURDIR()
|
||||
ENDIF
|
||||
|
||||
*** Configure the notification dialog
|
||||
OP = CREATEOBJECT("wwProgressForm")
|
||||
OP.WIDTH = 350
|
||||
OP.SetCaption("File Update")
|
||||
OP.SetDescription("Updating files for " + THIS.cApplicationName + "...")
|
||||
OP.HideProgressBar()
|
||||
OP.SHOW()
|
||||
|
||||
*** Force the form to update
|
||||
DOEVENTS
|
||||
|
||||
|
||||
*** Allow the application some time to go away
|
||||
INKEY(5,"HM")
|
||||
|
||||
*** Execute the RUN command and wait
|
||||
lcParms = [RUN /n7] + lcUpdateFile
|
||||
&lcParms
|
||||
|
||||
*** Wait for 5 seconds to allow unzipping to complete
|
||||
*** This should be plenty of time
|
||||
OP.SetDescription([Getting ready to restart ] +;
|
||||
THIS.cApplicationName + [...])
|
||||
INKEY(5,"HM")
|
||||
|
||||
*** Make sure the new Exe exists - if not wait longer
|
||||
IF !FILE(THIS.cExeFile)
|
||||
*** Wait 5 more seconds
|
||||
INKEY(5,"HM")
|
||||
ENDIF
|
||||
|
||||
*** And start up the EXE
|
||||
lcParms = [RUN /n1 ] + THIS.cExeFile + ;
|
||||
IIF(!EMPTY(THIS.cCommandLineParameters)," " + THIS.cCommandLineParameters,"")
|
||||
&lcParms
|
||||
|
||||
RETURN
|
||||
|
||||
RETURN
|
||||
* wwCodeUpdate :: UpdateExe
|
||||
|
||||
************************************************************************
|
||||
* wwCodeUpdate :: RunUpdateExe
|
||||
*********************************
|
||||
*** Function:
|
||||
*** Assume:
|
||||
*** Pass:
|
||||
*** Return:
|
||||
************************************************************************
|
||||
FUNCTION RunUpdateExe
|
||||
LPARAMETER lcUpdateExe
|
||||
|
||||
*** Run external program to copy in the files
|
||||
lcParms = [RUN /n1 ] + lcUpdateExe
|
||||
*Messagebox(lcParms)
|
||||
&lcParms
|
||||
|
||||
*** Required if READ EVENTS IS ACTIVE
|
||||
*** otherwise EXE won't release
|
||||
IF RDLEVEL() > 0
|
||||
CLEAR EVENTS
|
||||
ENDIF
|
||||
|
||||
ON ERROR *
|
||||
ON SHUTDOWN
|
||||
*!* CLEAR DLLS
|
||||
*!* RELEASE ALL
|
||||
*!* CLEAR ALL
|
||||
|
||||
DOEVENTS
|
||||
|
||||
QUIT
|
||||
|
||||
ENDFUNC
|
||||
* wwCodeUpdate :: RunUpdateExe
|
||||
|
||||
************************************************************************
|
||||
* wwCodeUpdate :: CopyUpdate
|
||||
*********************************
|
||||
*** Function: Once downloaded copies the update
|
||||
*** Assume:
|
||||
*** Pass:
|
||||
*** Return:
|
||||
************************************************************************
|
||||
FUNCTION CopyUpdate
|
||||
|
||||
OP = CREATEOBJECT("wwProgressForm")
|
||||
OP.SetCaption("File Update")
|
||||
OP.SetDescription("Updating file:" + THIS.cExeFile)
|
||||
OP.HideProgressBar()
|
||||
OP.SHOW()
|
||||
|
||||
IF MESSAGEBOX("Ready to update your application",32+4,"Code Update") = 6
|
||||
COPY FILE (THIS.cExeFile) TO (".\codeupdate\" + THIS.cExeFile + "_bak")
|
||||
COPY FILE (".\codeupdate\" + THIS.cExeFile) TO (THIS.cExeFile)
|
||||
ENDIF
|
||||
|
||||
ENDFUNC
|
||||
* wwCodeUpdate :: CopyUpdate
|
||||
|
||||
************************************************************************
|
||||
* wwCodeUpdate :: CreateHTTPClient
|
||||
****************************************
|
||||
*** Function:
|
||||
*** Assume:
|
||||
*** Pass:
|
||||
*** Return:
|
||||
************************************************************************
|
||||
FUNCTION CreateHTTPClient()
|
||||
THIS.oHTTP = CREATEOBJECT("CU_wwHTTP")
|
||||
THIS.oHTTP.nConnectTimeout = THIS.nConnectTimeout
|
||||
RETURN THIS.oHTTP
|
||||
ENDFUNC
|
||||
* wwCodeUpdate :: CreateHTTPClient
|
||||
|
||||
************************************************************************
|
||||
* wwCodeUpdate :: SetError
|
||||
*********************************
|
||||
PROTECTED FUNCTION SetError
|
||||
LPARAMETERS lcErrorMsg
|
||||
|
||||
IF PCOUNT() = 0
|
||||
THIS.lError = ""
|
||||
THIS.cErrorMsg = ""
|
||||
ELSE
|
||||
THIS.lError = .T.
|
||||
THIS.cErrorMsg = lcErrorMsg
|
||||
ENDIF
|
||||
|
||||
ENDFUNC
|
||||
* wwCodeUpdate :: SetError
|
||||
|
||||
ENDDEFINE
|
||||
|
||||
|
||||
|
||||
|
||||
*****************************************************
|
||||
DEFINE CLASS CU_wwHTTP AS wwHTTP
|
||||
**************************************
|
||||
|
||||
*** Custom properties dealing with display
|
||||
*** of download information
|
||||
lShowDialog = .F.
|
||||
oProgressForm = .NULL.
|
||||
cCaption = "Se descarca actualizarea..."
|
||||
nContentSize = 0
|
||||
|
||||
************************************************************************
|
||||
* CU_wwHTTP :: OnHTTPBufferUpdate
|
||||
************************************
|
||||
*** Function: HTTP Progress Event Handler
|
||||
*** Assume: Relies on wwDialogs.vcx for Progress Form
|
||||
*** Pass:
|
||||
*** Return:
|
||||
************************************************************************
|
||||
FUNCTION OnHTTPBufferUpdate
|
||||
LPARAMETERS lnbytes,lnbufferreads,lccurrentchunk
|
||||
|
||||
DO CASE
|
||||
*** If this is the 0 chunk it's HTTP Header
|
||||
CASE lnbufferreads = 0
|
||||
THIS.nContentSize = VAL( Extract(lccurrentchunk,CHR(13)+CHR(10) + "Content-length: ",CHR(13)) )
|
||||
DO CASE
|
||||
CASE THIS.nContentSize > 90000
|
||||
THIS.nHTTPWorkBufferSize = 16484
|
||||
CASE THIS.nContentSize > 40000
|
||||
THIS.nHTTPWorkBufferSize = 8182
|
||||
ENDCASE
|
||||
RETURN
|
||||
CASE lnbufferreads = -1
|
||||
*** Done
|
||||
DOEVENTS
|
||||
THIS.oProgressForm = .F.
|
||||
THIS.oProgressForm = .NULL.
|
||||
RETURN
|
||||
OTHERWISE
|
||||
DOEVENTS
|
||||
ENDCASE
|
||||
|
||||
IF THIS.lShowDialog
|
||||
IF lnbufferreads=1
|
||||
THIS.oProgressForm = CREATEOBJECT("wwProgressForm")
|
||||
THIS.oProgressForm.SetCaption(THIS.cCaption)
|
||||
THIS.oProgressForm.ShowCancelButton()
|
||||
THIS.oProgressForm.SHOW()
|
||||
ENDIF
|
||||
|
||||
IF THIS.oProgressForm.lCancelled
|
||||
THIS.lHTTPCancelDownload = .T.
|
||||
ENDIF
|
||||
|
||||
THIS.oProgressForm.SetDescription("S-au primit de la " + THIS.cServer + ":" +CHR(13) +;
|
||||
LTRIM( TRANSFORM(lnbytes,"999,999,999") ) + " din " +;
|
||||
LTRIM(TRANSFORM(THIS.nContentSize,"999,999,999"))+ " bytes")
|
||||
THIS.oProgressForm.SetProgress(lnbytes/THIS.nContentSize * 100)
|
||||
ENDIF
|
||||
|
||||
ENDFUNC
|
||||
|
||||
|
||||
ENDDEFINE
|
||||
586
COMUN/utile/web/wwresponse.prg
Normal file
586
COMUN/utile/web/wwresponse.prg
Normal file
@@ -0,0 +1,586 @@
|
||||
**
|
||||
** wwresponse.fxp
|
||||
**
|
||||
*
|
||||
DEFINE CLASS wwResponse AS RELATION
|
||||
laSpobject = .F.
|
||||
caUtosessioncookiename = "wwSessionId"
|
||||
caUtosessioncookie = ""
|
||||
laUtosessioncookiepersist = .F.
|
||||
csTylesheet = ""
|
||||
coUtput = .NULL.
|
||||
coNtenttype = ""
|
||||
PROTECTED lnOoutput
|
||||
lnOoutput = .F.
|
||||
*
|
||||
FUNCTION Write
|
||||
LPARAMETER lcText, llNooutput
|
||||
RETURN ""
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION Send
|
||||
LPARAMETER lcText, llNooutput
|
||||
RETURN ""
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION FastWrite
|
||||
LPARAMETER lcText, llNotused
|
||||
RETURN ""
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION GetOutput
|
||||
LPARAMETER llNoclear
|
||||
RETURN ""
|
||||
ENDFUNC
|
||||
*
|
||||
PROCEDURE Clear
|
||||
ENDPROC
|
||||
*
|
||||
PROCEDURE Rewind
|
||||
ENDPROC
|
||||
*
|
||||
PROCEDURE Reset
|
||||
ENDPROC
|
||||
*
|
||||
PROCEDURE reset
|
||||
STORE "" TO thIs.caUtosessioncookie, thIs.caUtosessioncookiename
|
||||
STORE .F. TO thIs.lnOoutput
|
||||
ENDPROC
|
||||
*
|
||||
FUNCTION HTMLHeader
|
||||
LPARAMETER tcHeader, tcTitle, tcBackground, tcContenttype, tlNooutput
|
||||
LOCAL lcOuttext
|
||||
tcHeader = IIF(EMPTY(tcHeader), "", tcHeader)
|
||||
tcTitle = IIF(EMPTY(tcTitle), tcHeader, tcTitle)
|
||||
tcBackground = IIF(EMPTY(tcBackground), "", tcBackground)
|
||||
thIs.coNtenttypeheader(tcContenttype)
|
||||
IF .NOT. EMPTY(tcBackground)
|
||||
lcBackground = IIF(AT("#", tcBackground)>0, 'BGCOLOR="', ;
|
||||
'BACKGROUND="')+LOWER(tcBackground)+'"'
|
||||
ELSE
|
||||
lcBackground = ""
|
||||
ENDIF
|
||||
lcOuttext = "<HTML>"+CHR(13)+CHR(10)+"<HEAD><TITLE>"+tcTitle+ ;
|
||||
"</TITLE></HEAD>"+CHR(13)+CHR(10)+IIF( .NOT. ;
|
||||
EMPTY(thIs.csTylesheet), ;
|
||||
'<LINK rel="stylesheet" type="text/css" href="'+ ;
|
||||
thIs.csTylesheet+'">', "")+CHR(13)+CHR(10)+'<BODY '+ ;
|
||||
lcBackground+'>'+CHR(13)+CHR(10)
|
||||
IF ATC("<", tcHeader)>0 .AND. ATC(">", tcHeader)>0
|
||||
lcOuttext = lcOuttext+thIs.wrIte(tcHeader+CHR(13)+CHR(10),.T.)+ ;
|
||||
CHR(13)+CHR(10)
|
||||
ELSE
|
||||
IF .NOT. EMPTY(tcHeader)
|
||||
lcOuttext = lcOuttext+'<FONT FACE="Verdana"><H1>'+ ;
|
||||
tcHeader+'</H1></Font><HR>'+CHR(13)+CHR(10)
|
||||
ENDIF
|
||||
ENDIF
|
||||
RETURN thIs.wrIte(@lcOuttext,tlNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
PROCEDURE HTMLHeaderEx
|
||||
LPARAMETER lvHtmlheader, loHttpheader
|
||||
thIs.coNtenttypeheader(loHttpheader)
|
||||
IF VARTYPE(lvHtmlheader)="O"
|
||||
thIs.wrIte(lvHtmlheader.geToutput())
|
||||
ELSE
|
||||
IF VARTYPE(lvHtmlheader)="C"
|
||||
thIs.wrIte("<html><head><title>"+lvHtmlheader+"</title><body>")
|
||||
ELSE
|
||||
thIs.wrIte("<html><body>")
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDPROC
|
||||
*
|
||||
FUNCTION HTMLFooter
|
||||
LPARAMETER tcText, tlNooutput
|
||||
tcText = IIF(EMPTY(tcText), "", tcText)
|
||||
RETURN thIs.wrIte(tcText+CHR(13)+CHR(10)+"<p></BODY>"+CHR(13)+ ;
|
||||
CHR(10)+"</HTML>"+CHR(13)+CHR(10),tlNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION WriteLn
|
||||
LPARAMETER lcOutput, llNooutput
|
||||
IF EMPTY(lcOutput)
|
||||
lcOutput = ""
|
||||
ENDIF
|
||||
RETURN thIs.wrIte(lcOutput+CHR(13)+CHR(10),llNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION Sendln
|
||||
LPARAMETER lcOutput, llNooutput
|
||||
IF EMPTY(lcOutput)
|
||||
lcOutput = ""
|
||||
ENDIF
|
||||
RETURN thIs.wrIte(lcOutput+CHR(13)+CHR(10),llNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION ContentTypeHeader
|
||||
LPARAMETER lvContenttype, tlNooutput
|
||||
LOCAL loHeader, lcType, lcOutput
|
||||
lcType = VARTYPE(lvContenttype)
|
||||
DO CASE
|
||||
CASE lcType="O"
|
||||
IF .NOT. lvContenttype.lpAssedhtmlobject
|
||||
RETURN thIs.wrIte(lvContenttype.geToutput(),tlNooutput)
|
||||
ELSE
|
||||
lvContenttype.coMpleteheader()
|
||||
ENDIF
|
||||
RETURN ""
|
||||
CASE lcType="C"
|
||||
lvContenttype = LOWER(lvContenttype)
|
||||
IF lvContenttype="none" .OR. EMPTY(lvContenttype)
|
||||
RETURN ""
|
||||
ENDIF
|
||||
lvContenttype = LOWER(lvContenttype)
|
||||
loHeader = CREATEOBJECT('wwHTTPHeader', thIs)
|
||||
IF lvContenttype="force reload"
|
||||
loHeader.deFaultheader()
|
||||
loHeader.adDforcereload()
|
||||
loHeader.coMpleteheader()
|
||||
RETURN ""
|
||||
ENDIF
|
||||
loHeader.seTprotocol()
|
||||
loHeader.seTcontenttype(lvContenttype)
|
||||
loHeader.coMpleteheader()
|
||||
RETURN ""
|
||||
OTHERWISE
|
||||
loHeader = CREATEOBJECT('wwHTTPHeader', thIs)
|
||||
loHeader.deFaultheader()
|
||||
loHeader.coMpleteheader()
|
||||
RETURN ""
|
||||
ENDCASE
|
||||
RETURN thIs.wrIte(loHeader.geToutput(),tlNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION WriteMemo
|
||||
LPARAMETER lcText, llNooutput
|
||||
LOCAL lcOutput
|
||||
lcOutput = STRTRAN(lcText, CHR(13)+CHR(10), CHR(13))
|
||||
lcOutput = STRTRAN(lcOutput, CHR(13)+CHR(13), "<p>")
|
||||
lcOutput = STRTRAN(lcOutput, CHR(13), "<br>")
|
||||
RETURN thIs.wrIte(@lcOutput,llNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION ExpandTemplate
|
||||
LPARAMETER tcPagename, tcContenttype, tlTemplatestring, tlNooutput
|
||||
LOCAL lcOutput, lcOldalias, lnHandle, loEval
|
||||
IF EMPTY(tcPagename)
|
||||
RETURN ""
|
||||
ENDIF
|
||||
thIs.coNtenttypeheader(tcContenttype)
|
||||
lcOutput = ""
|
||||
IF .NOT. tlTemplatestring
|
||||
lnHandle = FOPEN(tcPagename, 0)
|
||||
IF lnHandle<>-1
|
||||
lnSize = FSEEK(lnHandle, 0, 2)
|
||||
FSEEK(lnHandle, 0, 0)
|
||||
lcOutput = FREAD(lnHandle, lnSize)
|
||||
= FCLOSE(lnHandle)
|
||||
loEval = CREATEOBJECT('wwEval')
|
||||
RETURN thIs.wrIte(loEval.meRgetext(@lcOutput),tlNooutput)
|
||||
ELSE
|
||||
RETURN thIs.wrIte(lcOutput+[<h2>Can't find or open page ]+ ;
|
||||
tcPagename+'</h2>',tlNooutput)
|
||||
ENDIF
|
||||
ENDIF
|
||||
loEval = CREATEOBJECT("wwEval")
|
||||
RETURN thIs.wrIte(loEval.meRgetext(@tcPagename),tlNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION ExpandScript
|
||||
LPARAMETER tcPagename, tnMode, tvContenttype, tlTemplatestring, ;
|
||||
llNooutput
|
||||
LOCAL lcOutput, lnHandle, osCript
|
||||
tcPagename = IIF(EMPTY(tcPagename), "", tcPagename)
|
||||
tnMode = IIF(EMPTY(tnMode), 3, tnMode)
|
||||
thIs.coNtenttypeheader(tvContenttype)
|
||||
lcOutput = ""
|
||||
IF llNooutput
|
||||
loResponse = CREATEOBJECT('wwResponseStringNoBuffer')
|
||||
ELSE
|
||||
loResponse = thIs
|
||||
ENDIF
|
||||
osCript = CREATEOBJECT('wwVFPScript', IIF(tlTemplatestring, .F., ;
|
||||
tcPagename), loResponse)
|
||||
osCript.laLwaysunloadscript = .T.
|
||||
IF tnMode=3
|
||||
IF tlTemplatestring
|
||||
lcCode = osCript.coNvertpage(tcPagename,.T.)
|
||||
ELSE
|
||||
lcCode = osCript.coNvertpage(fiLe2var(osCript.cfIlename),.T.)
|
||||
ENDIF
|
||||
osCript.reNderpagefromvar(lcCode)
|
||||
IF llNooutput
|
||||
RETURN loResponse.geToutput()
|
||||
ENDIF
|
||||
RETURN
|
||||
ENDIF
|
||||
IF tnMode=2
|
||||
osCript.reNderpage()
|
||||
ENDIF
|
||||
IF tnMode=1
|
||||
osCript.coNvertpage()
|
||||
osCript.reNderpage()
|
||||
ENDIF
|
||||
IF llNooutput
|
||||
RETURN loResponse.geToutput()
|
||||
ENDIF
|
||||
RETURN
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION ShowCursor
|
||||
LPARAMETER lvHeader, lcTitle, llSumnumbers, llNooutput, lcTabletags
|
||||
LOCAL lcHeader, lnX, laTotals, lcOutput, lnSizeloc, lnSize, lvValue
|
||||
IF EMPTY(ALIAS())
|
||||
RETURN ""
|
||||
ENDIF
|
||||
lcOutput = ""
|
||||
lnFields = AFIELDS(laFields)
|
||||
lnReccount = RECCOUNT()
|
||||
IF llSumnumbers
|
||||
DIMENSION laTotals[1, lnFields]
|
||||
laTotals = 0
|
||||
ENDIF
|
||||
lcTitle = IIF(TYPE("lcTitle")="C", lcTitle, "")
|
||||
IF .NOT. llNooutput
|
||||
loShowcursor = CREATEOBJECT("wwShowCursor", thIs)
|
||||
ELSE
|
||||
loShowcursor = CREATEOBJECT("wwShowCursor")
|
||||
ENDIF
|
||||
loShowcursor.ctAbletitle = lcTitle
|
||||
loShowcursor.lsUmnumerics = llSumnumbers
|
||||
loShowcursor.laLternaterows = .T.
|
||||
IF .NOT. EMPTY(lcTabletags)
|
||||
loShowcursor.ceXtratabletags = lcTabletags
|
||||
ENDIF
|
||||
IF TYPE("lvHeader[1]")<>"U"
|
||||
loShowcursor.buIldfieldlistheader(@lvHeader)
|
||||
ENDIF
|
||||
loShowcursor.shOwcursor()
|
||||
IF llNooutput
|
||||
RETURN loShowcursor.geToutput()
|
||||
ENDIF
|
||||
RETURN ""
|
||||
ENDFUNC
|
||||
*
|
||||
PROCEDURE NoOutput
|
||||
LPARAMETER llNooutput
|
||||
thIs.lnOoutput = .T.
|
||||
ENDPROC
|
||||
*
|
||||
FUNCTION StandardPage
|
||||
LPARAMETER lcHeader, lcBody, lvHeader, lnRefresh, lcRefreshurl, ;
|
||||
llNooutput
|
||||
LOCAL lcOutput
|
||||
lcHeader = IIF( .NOT. EMPTY(lcHeader), lcHeader, "")
|
||||
lcBody = IIF( .NOT. EMPTY(lcBody), lcBody, "")
|
||||
lnRefresh = IIF(EMPTY(lnRefresh), 0, lnRefresh)
|
||||
IF lnRefresh>0
|
||||
lcRefreshurl = IIF(EMPTY(lcRefreshurl), "", lcRefreshurl)
|
||||
ENDIF
|
||||
loHtml = CREATEOBJECT('wwResponseStringNoBuffer')
|
||||
loHtml.coNtenttypeheader(lvHeader)
|
||||
lcOutput = '<table border="0" cellpadding="5" width="100%">'+ ;
|
||||
CHR(13)+CHR(10)+ ;
|
||||
' <tr><td align="center" colspan="2" bgcolor="#000000">'+ ;
|
||||
CHR(13)+CHR(10)+ ;
|
||||
' <font color="#FFFFFF" size="4" face="Verdana"><b>'+ ;
|
||||
CHR(13)+CHR(10)+lcHeader+'</b></font>'+CHR(13)+CHR(10)+ ;
|
||||
' </td></tr>'+CHR(13)+CHR(10)+' <tr><td><br><p>'+ ;
|
||||
CHR(13)+CHR(10)+' <font face="Verdana" size=2>'+CHR(13)+ ;
|
||||
CHR(10)+lcBody+'</font>'+CHR(13)+CHR(10)+' </td></tr>'+ ;
|
||||
CHR(13)+CHR(10)+'</Table>'
|
||||
lcOutput = '<html><head>'+CHR(13)+CHR(10)+'<title>'+lcHeader+ ;
|
||||
'</title>'+CHR(13)+CHR(10)+IIF(lnRefresh>0, ;
|
||||
'<META HTTP-EQUIV="Refresh" CONTENT="'+ ;
|
||||
TRANSFORM(lnRefresh)+'; URL='+lcRefreshurl+'">', '')+ ;
|
||||
CHR(13)+CHR(10)+'</head>'+CHR(13)+CHR(10)+ ;
|
||||
'<body color="#FFFFFF" style="font:normal normal x-small Verdana">'+ ;
|
||||
CHR(13)+CHR(10)+lcOutput
|
||||
loHtml.wrIte(lcOutput)
|
||||
loHtml.htMlfooter()
|
||||
RETURN thIs.wrIte(loHtml.geToutput(),llNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION tagtext
|
||||
LPARAMETER lcTag, lcText, llNooutput
|
||||
RETURN thIs.wrIte("<"+lcTag+">"+lcText+"</"+lcTag+">",llNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION Authenticate
|
||||
LPARAMETER lcRealm, lcErrormsg, llNooutput
|
||||
LOCAL loHeader, lcOutput
|
||||
loHeader = CREATEOBJECT('wwHTTPHeader')
|
||||
loHeader.auThenticate(lcRealm,lcErrormsg)
|
||||
thIs.clEar()
|
||||
lcOutput = thIs.wrIte(loHeader.geToutput(),llNooutput)
|
||||
thIs.lnOoutput = .T.
|
||||
RETURN lcOutput
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION Redirect
|
||||
LPARAMETER tcUrl, tlNooutput
|
||||
LOCAL loHeader, lcOutput
|
||||
loHeader = CREATEOBJECT('wwHTTPHeader')
|
||||
loHeader.reDirect(tcUrl)
|
||||
thIs.clEar()
|
||||
lcOutput = thIs.wrIte(loHeader.geToutput(),tlNooutput)
|
||||
thIs.lnOoutput = .T.
|
||||
RETURN lcOutput
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION FormHeader
|
||||
LPARAMETER lcAction, lcMethod, lcTarget, lcExtratags, llNooutput
|
||||
IF EMPTY(lcMethod)
|
||||
lcMethod = "POST"
|
||||
ENDIF
|
||||
IF EMPTY(lcExtratags)
|
||||
lcExtratags = ""
|
||||
ENDIF
|
||||
RETURN thIs.wrIte('<FORM ACTION="'+lcAction+'" METHOD="'+lcMethod+ ;
|
||||
'" '+IIF( .NOT. EMPTY(lcTarget), ' TARGET="'+lcTarget+'" ', ;
|
||||
'')+lcExtratags+'>',llNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION formtextbox
|
||||
LPARAMETER lcName, lcValue, lnWidth, lnMaxwidth, lcCustomtags, llNooutput
|
||||
IF EMPTY(lnWidth)
|
||||
lnWidth = 20
|
||||
ENDIF
|
||||
IF EMPTY(lnMaxwidth)
|
||||
lnMaxwidth = 0
|
||||
ENDIF
|
||||
IF EMPTY(lcCustomtags)
|
||||
lcCustomtags = ""
|
||||
ENDIF
|
||||
lcOutput = '<INPUT TYPE="INPUT" NAME="'+lcName+'" VALUE="'+lcValue+'"'
|
||||
IF .NOT. EMPTY(lnWidth)
|
||||
lcOutput = lcOutput+' SIZE="'+LTRIM(STR(lnWidth, 3))+'"'
|
||||
ENDIF
|
||||
IF .NOT. EMPTY(lnMaxwidth)
|
||||
lcOutput = lcOutput+' MAXLENGTH="'+LTRIM(STR(lnMaxwidth, 3))+'"'
|
||||
ENDIF
|
||||
IF .NOT. EMPTY(lcCustomtags)
|
||||
lcOutput = lcOutput+' '+lcCustomtags
|
||||
ENDIF
|
||||
RETURN thIs.wrIte(lcOutput+'>',llNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION formtextarea
|
||||
LPARAMETER lcName, lcValue, lnHeight, lnWidth, lcCustomtags, llNooutput
|
||||
IF EMPTY(lnWidth)
|
||||
lnWidth = 20
|
||||
ENDIF
|
||||
IF EMPTY(lnHeight)
|
||||
lnHeight = 0
|
||||
ENDIF
|
||||
IF EMPTY(lcCustomtags)
|
||||
lcCustomtags = ""
|
||||
ENDIF
|
||||
lcOutput = '<TEXTAREA NAME="'+lcName+'"'
|
||||
IF .NOT. EMPTY(lnWidth)
|
||||
lcOutput = lcOutput+' COLS="'+LTRIM(STR(lnWidth, 3))+'"'
|
||||
ENDIF
|
||||
IF .NOT. EMPTY(lnHeight)
|
||||
lcOutput = lcOutput+' ROWS="'+LTRIM(STR(lnHeight, 3))+'"'
|
||||
ENDIF
|
||||
IF .NOT. EMPTY(lcCustomtags)
|
||||
lcOutput = lcOutput+' '+lcCustomtags
|
||||
ENDIF
|
||||
RETURN thIs.wrIte(lcOutput+'>'+lcValue+'</TEXTAREA>',llNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION formhidden
|
||||
LPARAMETER lcName, lcValue, llNooutput
|
||||
RETURN thIs.wrIte('<INPUT TYPE="HIDDEN" NAME="'+lcName+'" VALUE="'+ ;
|
||||
lcValue+'">',llNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION formcheckbox
|
||||
LPARAMETER lcName, llValue, lcText, lcCustomtags, llNooutput
|
||||
lcCustomtags = IIF(TYPE("lcCustomTags")="C", lcCustomtags, "")
|
||||
lcText = IIF(TYPE("lcText")="C", lcText, "")
|
||||
RETURN thIs.wrIte('<INPUT TYPE="CheckBox" VALUE="ON" NAME="'+ ;
|
||||
lcName+'"'+IIF(llValue, " CHECKED", "")+" "+lcCustomtags+'>'+ ;
|
||||
lcText,llNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION formradio
|
||||
LPARAMETER lcName, lcValue, lcText, llSelected, lcCustomtags, llNooutput
|
||||
IF EMPTY(lcCustomtags)
|
||||
lcCustomtags = ""
|
||||
ENDIF
|
||||
RETURN thIs.wrIte('<INPUT TYPE="Radio" Value="'+lcValue+'" NAME="'+ ;
|
||||
lcName+'"'+IIF(llSelected, " CHECKED", "")+" "+lcCustomtags+ ;
|
||||
'> '+lcText,llNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION formbutton
|
||||
LPARAMETER lcName, lcCaption, lcType, lnWidth, lcCustomtags, llNooutput
|
||||
lnWidth = IIF(VARTYPE(lnWidth)="N", lnWidth, 20)
|
||||
lcCustomtags = IIF(VARTYPE(lcCustomtags)="C", lcCustomtags, "")
|
||||
lcType = IIF(VARTYPE(lcType)="C", lcType, "SUBMIT")
|
||||
lcOutput = '<INPUT TYPE="'+lcType+'" NAME="'+lcName+'" VALUE="'+ ;
|
||||
lcCaption+'"'
|
||||
IF .NOT. EMPTY(lnWidth)
|
||||
lcOutput = lcOutput+' SIZE="'+LTRIM(STR(lnWidth, 3))+'"'
|
||||
ENDIF
|
||||
IF .NOT. EMPTY(lcCustomtags)
|
||||
lcOutput = lcOutput+' '+lcCustomtags
|
||||
ENDIF
|
||||
RETURN thIs.wrIte(lcOutput+'>',llNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION HRef
|
||||
LPARAMETER lcLink, lcText, tlNooutput
|
||||
IF EMPTY(lcText)
|
||||
lcText = lcLink
|
||||
ENDIF
|
||||
RETURN thIs.wrIte('<A HREF="'+lcLink+'">'+lcText+'</A>',tlNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION DBFPopup
|
||||
LPARAMETER lcFormvarname, lcCharexpression, lcDefault, lcFirstitem, ;
|
||||
lnHeight, llNooutput, llMultiselect, lcKey
|
||||
LOCAL lnX, lcOutput, lcValue, lcKey, lcInsertkey
|
||||
lcCharexpression = IIF(VARTYPE(lcCharexpression)="C", ;
|
||||
lcCharexpression, FIELD(1))
|
||||
lnHeight = IIF(VARTYPE(lnHeight)="N", lnHeight, 1)
|
||||
lcDefault = IIF(VARTYPE(lcDefault)="C", lcDefault, " xxxx")
|
||||
lcFirstitem = IIF(VARTYPE(lcFirstitem)="C", lcFirstitem, " xxxx")
|
||||
lcKey = IIF(VARTYPE(lcKey)="C", lcKey, "")
|
||||
lcOutput = '<SELECT NAME="'+lcFormvarname+'" SIZE="'+ ;
|
||||
ALLTRIM(STR(lnHeight))+'"'+IIF(llMultiselect, ;
|
||||
' MULTIPLE', '')+'>'
|
||||
lnX = 0
|
||||
IF lcFirstitem<>" xxxx"
|
||||
lnX = 1
|
||||
lcOutput = lcOutput+'<OPTION>'+lcFirstitem+CHR(13)+CHR(10)
|
||||
ENDIF
|
||||
SCAN
|
||||
lnX = lnX+1
|
||||
lcInsertkey = IIF( .NOT. EMPTY(lcKey), ' Value ="'+ ;
|
||||
EVALUATE(lcKey)+'" ', '')
|
||||
lcValue = EVALUATE(lcCharexpression)
|
||||
IF UPPER(lcDefault)=UPPER(TRIM(lcValue))
|
||||
lcOutput = lcOutput+'<OPTION SELECTED'+lcInsertkey+'>'+ ;
|
||||
lcValue+CHR(13)+CHR(10)
|
||||
ELSE
|
||||
lcOutput = lcOutput+'<OPTION '+lcInsertkey+'>'+lcValue+ ;
|
||||
CHR(13)+CHR(10)
|
||||
ENDIF
|
||||
ENDSCAN
|
||||
lcOutput = lcOutput+"</SELECT>"
|
||||
RETURN thIs.wrIte(@lcOutput,llNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION IEChart
|
||||
LPARAMETER lcType, lnDatacols, lvWidth, lnHeight, lcLabels, llNooutput
|
||||
LOCAL lnX, y, lnReccount, lnFields, lcOutput, lcWidth
|
||||
lnDatacols = IIF(TYPE("lnDataCols")="N", lnDatacols, 1)
|
||||
lcLabels = IIF(TYPE("lcLabels")="C", lcLabels, "")
|
||||
lcType = IIF(TYPE("lcType")="C", UPPER(lcType), "")
|
||||
lvWidth = IIF(TYPE("lvWidth")<>"L", lvWidth, "100%")
|
||||
lnHeight = IIF(TYPE("lnHeight")="N", lnHeight, 250)
|
||||
IF TYPE("lvWidth")="N"
|
||||
lcWidth = LTRIM(STR(lvWidth))
|
||||
ELSE
|
||||
lcWidth = lvWidth
|
||||
ENDIF
|
||||
DO CASE
|
||||
CASE lcType="BAR"
|
||||
lcType = "12"
|
||||
CASE lcType="LINE"
|
||||
lcType = "5"
|
||||
CASE lcType="AREA"
|
||||
lcType = "8"
|
||||
CASE lcType="PIE"
|
||||
lcType = "1"
|
||||
OTHERWISE
|
||||
IF VAL(lcType)=0
|
||||
lcType = "12"
|
||||
ENDIF
|
||||
ENDCASE
|
||||
lnFields = AFIELDS(laFields)
|
||||
lnReccount = RECCOUNT()
|
||||
lcOutput = ""
|
||||
lcOutput = lcOutput+'<OBJECT'+CHR(13)+CHR(10)+' ID="ocxGraph"'+ ;
|
||||
CHR(13)+CHR(10)+ ;
|
||||
' CLASSID="clsid:FC25B780-75BE-11CF-8B01-444553540000"'+ ;
|
||||
CHR(13)+CHR(10)+ ;
|
||||
' CODEBASE="http://activex.microsoft.com/controls/iexplorer/iechart.ocx#Version=4,70,0,1161"'+ ;
|
||||
CHR(13)+CHR(10)+' TYPE="application/x-oleobject"'+ ;
|
||||
CHR(13)+CHR(10)+' WIDTH='+lcWidth+CHR(13)+CHR(10)+ ;
|
||||
' HEIGHT='+LTRIM(STR(lnHeight))+'>'+CHR(13)+CHR(10)+ ;
|
||||
CHR(13)+CHR(10)
|
||||
lcOutput = lcOutput+' <PARAM NAME="hgridStyle" VALUE="3">'+CHR(13)+ ;
|
||||
CHR(10)+' <PARAM NAME="vgridStyle" VALUE="0">'+CHR(13)+ ;
|
||||
CHR(10)+' <PARAM NAME="colorscheme" VALUE="0">'+CHR(13)+ ;
|
||||
CHR(10)+' <PARAM NAME="BackStyle" VALUE="1">'+CHR(13)+ ;
|
||||
CHR(10)+' <PARAM NAME="BackColor" VALUE="#ffffCC">'+ ;
|
||||
CHR(13)+CHR(10)+ ;
|
||||
' <PARAM NAME="ForeColor" VALUE="#0000ff">'+CHR(13)+ ;
|
||||
CHR(10)+' <PARAM NAME="Scale" VALUE="100">'+CHR(13)+ ;
|
||||
CHR(10)+CHR(13)+CHR(10)
|
||||
lcOutput = lcOutput+IIF(lcType=="1", ;
|
||||
' <PARAM NAME="columns" VALUE="'+LTRIM(STR(lnReccount))+ ;
|
||||
'">', ' <PARAM NAME="rows" VALUE="'+ ;
|
||||
LTRIM(STR(lnReccount))+'">')+CHR(13)+CHR(10)+ ;
|
||||
' <PARAM NAME="ChartType" VALUE="'+lcType+'">'+CHR(13)+CHR(10)
|
||||
lcOutput = lcOutput+' <PARAM NAME="'+IIF(lcType=="1", ;
|
||||
"ColumnNames", "RowNames")+'" VALUE="'
|
||||
SCAN
|
||||
lcOutput = lcOutput+CHRTRAN(ALLTRIM(EVALUATE(laFields(1,1))), ;
|
||||
" ", "_")+" "
|
||||
ENDSCAN
|
||||
lcOutput = TRIM(lcOutput)+'">'+CHR(13)+CHR(10)
|
||||
IF .NOT. EMPTY(lcLabels)
|
||||
lcOutput = lcOutput+ ;
|
||||
' <PARAM NAME="ColumnNames" VALUE="'+ ;
|
||||
lcLabels+'">'+CHR(13)+CHR(10)+ ;
|
||||
' <PARAM NAME="DisplayLegend" VALUE="1'+'">'+ ;
|
||||
CHR(13)+CHR(10)
|
||||
ENDIF
|
||||
lnX = 0
|
||||
IF lcType=="1"
|
||||
SCAN
|
||||
lcOutput = lcOutput+' <PARAM NAME="DATA[0]['+ ;
|
||||
LTRIM(STR(lnX))+']" VALUE="'+ ;
|
||||
LTRIM(STR(EVALUATE(laFields(2,1))))+'">'+ ;
|
||||
CHR(13)+CHR(10)
|
||||
lnX = lnX+1
|
||||
ENDSCAN
|
||||
ELSE
|
||||
SCAN
|
||||
FOR y = 1 TO lnDatacols
|
||||
lcOutput = lcOutput+' <PARAM NAME="DATA['+ ;
|
||||
LTRIM(STR(lnX))+']['+LTRIM(STR(y-1))+ ;
|
||||
']" VALUE="'+ ;
|
||||
LTRIM(STR(EVALUATE(laFields(y+1,1))))+ ;
|
||||
'">'+CHR(13)+CHR(10)
|
||||
ENDFOR
|
||||
lnX = lnX+1
|
||||
ENDSCAN
|
||||
ENDIF
|
||||
lcOutput = lcOutput+ ;
|
||||
'This graph can be viewed with ActiveX enabled browsers only...<p>'+ ;
|
||||
'<A HREF="http://www.microsoft.com/ie/">Download Internet Explorer now!</a>'+ ;
|
||||
CHR(13)+CHR(10)+'</object>'+CHR(13)+CHR(10)
|
||||
RETURN thIs.wrIte(@lcOutput,llNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION ContentType_Assign
|
||||
LPARAMETER lcValue
|
||||
thIs.coNtenttype = lcValue
|
||||
thIs.coNtenttypeheader(lcValue)
|
||||
RETURN lcValue
|
||||
ENDFUNC
|
||||
*
|
||||
PROCEDURE BinaryWrite
|
||||
LPARAMETER lcText
|
||||
thIs.wrIte(lcText)
|
||||
ENDPROC
|
||||
*
|
||||
ENDDEFINE
|
||||
*
|
||||
177
COMUN/utile/web/wwresponsestring.prg
Normal file
177
COMUN/utile/web/wwresponsestring.prg
Normal file
@@ -0,0 +1,177 @@
|
||||
**
|
||||
** wwresponsestring.fxp
|
||||
**
|
||||
SET PROCEDURE TO wwResponse ADDITIVE
|
||||
ENDPROC
|
||||
*
|
||||
DEFINE CLASS wwResponseString AS wwResponse
|
||||
coUtput = ""
|
||||
PROTECTED cfIlename
|
||||
cfIlename = ""
|
||||
PROTECTED ldUmptofile
|
||||
ldUmptofile = .F.
|
||||
PROTECTED chTmlfilename
|
||||
chTmlfilename = ""
|
||||
PROTECTED ohTmlfile
|
||||
ohTmlfile = .NULL.
|
||||
nbUffersize = 10000
|
||||
*
|
||||
FUNCTION getoutput
|
||||
LPARAMETER llNoclear
|
||||
LOCAL lcFile, lcOutput
|
||||
IF thIs.ldUmptofile
|
||||
thIs.ohTmlfile.deStroy()
|
||||
thIs.ohTmlfile = .NULL.
|
||||
thIs.ldUmptofile = .F.
|
||||
lcOutput = fiLe2var(thIs.chTmlfilename)
|
||||
ERASE (thIs.chTmlfilename)
|
||||
IF llNoclear
|
||||
thIs.coUtput = lcOutput
|
||||
ELSE
|
||||
thIs.coUtput = ""
|
||||
ENDIF
|
||||
RETURN lcOutput
|
||||
ENDIF
|
||||
IF llNoclear
|
||||
RETURN thIs.coUtput
|
||||
ENDIF
|
||||
lcOutput = thIs.coUtput
|
||||
thIs.coUtput = ""
|
||||
RETURN lcOutput
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION getoutputnoclear
|
||||
RETURN thIs.geToutput(.T.)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION WRITE
|
||||
LPARAMETER tcText, tlNooutput
|
||||
IF tlNooutput .OR. thIs.lnOoutput
|
||||
RETURN tcText
|
||||
ENDIF
|
||||
IF thIs.ldUmptofile
|
||||
thIs.ohTmlfile.faStwrite(@tcText)
|
||||
ELSE
|
||||
IF LEN(thIs.coUtput)<thIs.nbUffersize
|
||||
thIs.coUtput = thIs.coUtput+tcText
|
||||
ELSE
|
||||
thIs.ldUmptofile = .T.
|
||||
thIs.ohTmlfile = CREATEOBJECT('wwResponseFile', SYS(2023)+ ;
|
||||
"\"+SYS(2015)+TRIM(TRANSFORM(RAND()*1000, ;
|
||||
'999'))+".tmp")
|
||||
thIs.chTmlfilename = thIs.ohTmlfile.cfIlename
|
||||
thIs.ohTmlfile.faStwrite(thIs.coUtput+tcText)
|
||||
ENDIF
|
||||
ENDIF
|
||||
RETURN ""
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION SEND
|
||||
LPARAMETER tcText, tlNooutput
|
||||
RETURN thIs.wrIte(@tcText,tlNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION FastWrite
|
||||
LPARAMETER tcText, tlNooutput
|
||||
IF thIs.ldUmptofile
|
||||
thIs.ohTmlfile.faStwrite(@tcText)
|
||||
ELSE
|
||||
IF LEN(thIs.coUtput)<thIs.nbUffersize
|
||||
thIs.coUtput = thIs.coUtput+tcText
|
||||
ELSE
|
||||
thIs.wrIte(@tcText)
|
||||
ENDIF
|
||||
ENDIF
|
||||
RETURN ""
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION FastSend
|
||||
LPARAMETER tcText, tlNooutput
|
||||
RETURN thIs.faStwrite(@tcText,tlNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
PROCEDURE CLEAR
|
||||
IF thIs.ldUmptofile
|
||||
thIs.ohTmlfile.deStroy()
|
||||
thIs.ohTmlfile = .NULL.
|
||||
IF .NOT. EMPTY(thIs.chTmlfilename)
|
||||
ERASE (thIs.chTmlfilename)
|
||||
ENDIF
|
||||
ENDIF
|
||||
thIs.ldUmptofile = .F.
|
||||
thIs.ohTmlfile = .NULL.
|
||||
thIs.coUtput = ""
|
||||
ENDPROC
|
||||
*
|
||||
PROCEDURE Rewind
|
||||
thIs.clEar()
|
||||
ENDPROC
|
||||
*
|
||||
PROCEDURE DESTROY
|
||||
IF thIs.ldUmptofile
|
||||
IF .NOT. ISNULL(thIs.ohTmlfile)
|
||||
thIs.ohTmlfile.deStroy()
|
||||
ENDIF
|
||||
ERASE (thIs.chTmlfilename)
|
||||
ENDIF
|
||||
ENDPROC
|
||||
*
|
||||
PROCEDURE INIT
|
||||
LPARAMETER lcReserved
|
||||
ENDPROC
|
||||
*
|
||||
ENDDEFINE
|
||||
*
|
||||
DEFINE CLASS wwResponseStringNoBuffer AS wwResponse
|
||||
coUtput = ""
|
||||
*
|
||||
FUNCTION getoutput
|
||||
LPARAMETER llNoclear
|
||||
LOCAL lcFile, lcOutput
|
||||
IF llNoclear
|
||||
RETURN thIs.coUtput
|
||||
ENDIF
|
||||
lcOutput = thIs.coUtput
|
||||
thIs.coUtput = ""
|
||||
RETURN lcOutput
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION getoutputnoclear
|
||||
LOCAL lcFile
|
||||
RETURN thIs.coUtput
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION WRITE
|
||||
LPARAMETER tcText, tlNooutput
|
||||
IF tlNooutput .OR. thIs.lnOoutput
|
||||
RETURN tcText
|
||||
ENDIF
|
||||
thIs.coUtput = thIs.coUtput+tcText
|
||||
RETURN ""
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION SEND
|
||||
LPARAMETER tcText, tlNooutput
|
||||
RETURN thIs.wrIte(@tcText,tlNooutput)
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION FastWrite
|
||||
LPARAMETER tcText, tlNooutput
|
||||
thIs.coUtput = thIs.coUtput+tcText
|
||||
RETURN ""
|
||||
ENDFUNC
|
||||
*
|
||||
PROCEDURE Rewind
|
||||
thIs.clEar()
|
||||
ENDPROC
|
||||
*
|
||||
PROCEDURE CLEAR
|
||||
thIs.coUtput = ""
|
||||
ENDPROC
|
||||
*
|
||||
PROCEDURE INIT
|
||||
LPARAMETER lcReserved
|
||||
ENDPROC
|
||||
*
|
||||
ENDDEFINE
|
||||
*
|
||||
1749
COMUN/utile/web/wwutils.PRG
Normal file
1749
COMUN/utile/web/wwutils.PRG
Normal file
File diff suppressed because it is too large
Load Diff
366
COMUN/utile/web/wwwebgraphs.prg
Normal file
366
COMUN/utile/web/wwwebgraphs.prg
Normal file
@@ -0,0 +1,366 @@
|
||||
**
|
||||
** wwwebgraphs.fxp
|
||||
**
|
||||
SET PROCEDURE TO wwWebGraphs ADDITIVE
|
||||
SET PROCEDURE TO wwUtils ADDITIVE
|
||||
SET PROCEDURE TO wwAPI ADDITIVE
|
||||
RETURN
|
||||
EXTERNAL ARRAY laGraphs, laLabels, laLegend
|
||||
ENDPROC
|
||||
*
|
||||
DEFINE CLASS wwWebGraphs AS Relation
|
||||
ngRaphtype = 0
|
||||
ccAption = ""
|
||||
ooWc = .NULL.
|
||||
coWcprogid = "OWC10.ChartSpace"
|
||||
cpHysicalpath = ""
|
||||
clOgicalpath = ""
|
||||
niMagetimeout = 300
|
||||
ciMagename = ""
|
||||
niMagewidth = 750
|
||||
niMageheight = 480
|
||||
cbAckcolor = "lightyellow"
|
||||
csEries1color = "darkred"
|
||||
csEries2color = "darkblue"
|
||||
csEries3color = "darkgreen"
|
||||
csEries4color = "orange"
|
||||
csEries5color = "purple"
|
||||
csEries6color = "pink"
|
||||
nMaxColors = 6
|
||||
nsHowlegend = 1
|
||||
*
|
||||
FUNCTION Init
|
||||
LPARAMETER llNoexistcheck
|
||||
|
||||
IF .NOT. llNoexistcheck .AND. .NOT. isComobject(thIs.coWcprogid)
|
||||
RETURN .F.
|
||||
ENDIF
|
||||
thIs.ooWc = CREATEOBJECT(thIs.coWcprogid)
|
||||
IF VARTYPE(thIs.ooWc)<>"O"
|
||||
RETURN .F.
|
||||
ENDIF
|
||||
RETURN
|
||||
ENDFUNC
|
||||
*
|
||||
FUNCTION GraphSetup
|
||||
LOCAL loGraph
|
||||
loGraph = thIs.ooWc.chArts.adD()
|
||||
loGraph.tyPe = thIs.ngRaphtype
|
||||
IF thIs.nsHowlegend>0
|
||||
loGraph.haSlegend = .T.
|
||||
ENDIF
|
||||
loGraph.plOtarea.inTerior.coLor = thIs.cbAckcolor
|
||||
IF .NOT. EMPTY(thIs.ccAption)
|
||||
thIs.ooWc.haSchartspacetitle = .T.
|
||||
thIs.ooWc.chArtspacetitle.caPtion = thIs.ccAption
|
||||
thIs.ooWc.chArtspacetitle.foNt.boLd = .T.
|
||||
ENDIF
|
||||
RETURN loGraph
|
||||
ENDFUNC
|
||||
*
|
||||
PROCEDURE ShowGraphFromCursor
|
||||
LOCAL x, y, loGraph, lnFields, lnRows, lnSeries, lcElement, lcArray, lnx, ocOnst
|
||||
lnFields = AFIELDS(laFields, ALIAS())
|
||||
lnRows = RECCOUNT()
|
||||
lnSeries = lnFields-1
|
||||
DIMENSION laLabels[lnRows]
|
||||
FOR x = 1 TO lnSeries
|
||||
lcArray = "DIMENSION laValues"+TRANSFORM(x)+"["+ ;
|
||||
TRANSFORM(lnRows)+"]"
|
||||
&lcArray
|
||||
ENDFOR
|
||||
x = 0
|
||||
SCAN
|
||||
x = x+1
|
||||
laLabels[x] = TRIM(EVALUATE(FIELD(2)))
|
||||
FOR y = 1 TO lnSeries
|
||||
lcElement = "laValues"+TRANSFORM(y)+"["+TRANSFORM(x)+"]"
|
||||
&lcElement = EVALUATE(FIELD(y+1))
|
||||
ENDFOR
|
||||
ENDSCAN
|
||||
ocOnst = thIs.ooWc.coNstants
|
||||
loGraph = thIs.grAphsetup()
|
||||
lnx = 0
|
||||
FOR x = 1 TO lnSeries
|
||||
loGraph.seRiescollection.adD()
|
||||
loSeries = loGraph.seRiescollection(x-1)
|
||||
lnx = lnx + 1
|
||||
IF .NOT. INLIST(thIs.ngRaphtype, 18, 19, 58, 59)
|
||||
|
||||
IF lnx > this.nMaxColors && 6 culori maxim
|
||||
lnx = 1
|
||||
ENDIF
|
||||
|
||||
loSeries.inTerior.coLor = EVALUATE("THIS.cSeries"+ ;
|
||||
TRANSFORM(lnx)+"Color")
|
||||
ELSE
|
||||
IF x>1
|
||||
EXIT
|
||||
ENDIF
|
||||
ENDIF
|
||||
lcArray = "@laValues"+TRANSFORM(x)
|
||||
loSeries.caPtion = PROPER(STRTRAN(TRIM(laFields(x+1,1)), "_", " "))
|
||||
loSeries.seTdata(ocOnst.chDimcategories,ocOnst.chDataliteral, ;
|
||||
@laLabels)
|
||||
loSeries.SetData(oConst.chDimValues, oConst.chDataLiteral, &lcArray)
|
||||
ENDFOR
|
||||
ENDPROC
|
||||
*
|
||||
PROCEDURE ShowGraphFromArray
|
||||
LPARAMETER laLabels, laSeries1, lcSeries1, laSeries2, lcSeries2, ;
|
||||
laSeries3, lcSeries3, laSeries4, lcSeries4, laSeries5, ;
|
||||
lcSeries5, laSeries6, lcSeries6
|
||||
LOCAL x, loGraph, lnSeries, lcArray, lcLabel
|
||||
lnSeries = (PCOUNT()-1)/2
|
||||
loGraph = thIs.grAphsetup()
|
||||
ocOnst = thIs.ooWc.coNstants
|
||||
FOR x = 1 TO lnSeries
|
||||
loGraph.seRiescollection.adD()
|
||||
IF .NOT. INLIST(thIs.ngRaphtype, 18, 19)
|
||||
loGraph.seRiescollection(x-1).inTerior.coLor = ;
|
||||
EVALUATE("THIS.cSeries"+ ;
|
||||
TRANSFORM(x)+"Color")
|
||||
ENDIF
|
||||
lcArray = "@laSeries"+TRANSFORM(x)
|
||||
lcLabel = EVALUATE("lcSeries"+TRANSFORM(x))
|
||||
loGraph.seRiescollection(x-1).caPtion = lcLabel
|
||||
loGraph.seRiescollection(x-1).seTdata(ocOnst.chDimcategories, ;
|
||||
ocOnst.chDataliteral,@laLabels)
|
||||
loGraph.SeriesCollection(x-1).SetData(oConst.chDimValues, oConst.chDataLiteral, &lcArray)
|
||||
ENDFOR
|
||||
ENDPROC
|
||||
*
|
||||
PROCEDURE ShowGraphFromMultiDimensionalArray
|
||||
LPARAMETER laGraphs, laLegend
|
||||
LOCAL loGraph, lnSeries, lnRows, llLegend, x, y
|
||||
lnSeries = ALEN(laGraphs, 2)-1
|
||||
lnRows = ALEN(laGraphs, 1)
|
||||
loGraph = thIs.grAphsetup()
|
||||
IF TYPE('ALEN(laLegend)')="N"
|
||||
llLegend = .T.
|
||||
ELSE
|
||||
llLegend = .F.
|
||||
loGraph.haSlegend = .F.
|
||||
ENDIF
|
||||
ocOnst = thIs.ooWc.coNstants
|
||||
DIMENSION laLabels[lnRows]
|
||||
FOR y = 1 TO lnRows
|
||||
laLabels[y] = laGraphs(y,1)
|
||||
ENDFOR
|
||||
FOR x = 2 TO lnSeries+1
|
||||
loGraph.seRiescollection.adD()
|
||||
IF .NOT. INLIST(thIs.ngRaphtype, 18, 19)
|
||||
loGraph.seRiescollection(x-2).inTerior.coLor = ;
|
||||
EVALUATE("THIS.cSeries"+ ;
|
||||
TRANSFORM(x)+"Color")
|
||||
ENDIF
|
||||
DIMENSION laArray[lnRows]
|
||||
FOR y = 1 TO lnRows
|
||||
laArray[y] = laGraphs(y,x)
|
||||
ENDFOR
|
||||
IF llLegend
|
||||
loGraph.seRiescollection(x-2).caPtion = laLegend(x-1)
|
||||
ENDIF
|
||||
loGraph.seRiescollection(x-2).seTdata(ocOnst.chDimcategories, ;
|
||||
ocOnst.chDataliteral,@laLabels)
|
||||
loGraph.seRiescollection(x-2).seTdata(ocOnst.chDimvalues, ;
|
||||
ocOnst.chDataliteral,@laArray)
|
||||
ENDFOR
|
||||
ENDPROC
|
||||
*
|
||||
FUNCTION GetOutput
|
||||
thIs.seTgraphicsoptions(thIs.ooWc.chArts(0))
|
||||
deLetefiles(thIs.cpHysicalpath+"IMG*.gif",thIs.niMagetimeout)
|
||||
thIs.ciMagename = "IMG"+SYS(2015)+TRANSFORM(apPlication.prOcessid)+".gif"
|
||||
thIs.ooWc.exPortpicture(thIs.cpHysicalpath+thIs.ciMagename,"gif", ;
|
||||
thIs.niMagewidth,thIs.niMageheight)
|
||||
RETURN '<img src="'+thIs.clOgicalpath+thIs.ciMagename+'">'
|
||||
ENDFUNC
|
||||
*
|
||||
PROCEDURE Clear
|
||||
thIs.ooWc.clEar()
|
||||
ENDPROC
|
||||
*
|
||||
FUNCTION ShowGraphInForm
|
||||
LPARAMETER lcFormcaption
|
||||
LOCAL loForm, as, foRm
|
||||
loForm = CREATEOBJECT("GraphForm")
|
||||
loForm.adDobject("oPicture","image")
|
||||
loForm.heIght = thIs.niMageheight
|
||||
loForm.wiDth = thIs.niMagewidth
|
||||
loForm.auTocenter = .T.
|
||||
IF .NOT. EMPTY(lcFormcaption)
|
||||
loForm.caPtion = lcFormcaption
|
||||
ENDIF
|
||||
loForm.opIcture.leFt = 0
|
||||
loForm.opIcture.toP = 0
|
||||
loForm.opIcture.heIght = thIs.niMageheight
|
||||
loForm.opIcture.wiDth = thIs.niMagewidth
|
||||
loForm.opIcture.piCture = thIs.cpHysicalpath+thIs.ciMagename
|
||||
loForm.opIcture.viSible = .T.
|
||||
loForm.shOw()
|
||||
RETURN loForm
|
||||
ENDFUNC
|
||||
*
|
||||
PROCEDURE GetGraphTypes
|
||||
LPARAMETER lcCursorname
|
||||
IF EMPTY(lcCursorname)
|
||||
lcCursorname = "wwWebGraphTypes"
|
||||
ENDIF
|
||||
CREATE CURSOR (lcCursorname) (naMe C (80), id I)
|
||||
TEXT TO lcVar
|
||||
#define chChartTypeColumnClustered 0
|
||||
#define chChartTypeColumnStacked 1
|
||||
#define chChartTypeColumnStacked100 2
|
||||
#define chChartTypeBarClustered 3
|
||||
#define chChartTypeBarStacked 4
|
||||
#define chChartTypeBarStacked100 5
|
||||
#define chChartTypeLine 6
|
||||
#define chChartTypeLineStacked 8
|
||||
#define chChartTypeLineStacked100 10
|
||||
#define chChartTypeLineMarkers 7
|
||||
#define chChartTypeLineStackedMarkers 9
|
||||
#define chChartTypeLineStacked100Markers 11
|
||||
#define chChartTypeSmoothLine 12
|
||||
#define chChartTypeSmoothLineStacked 14
|
||||
#define chChartTypeSmoothLineStacked100 16
|
||||
#define chChartTypeSmoothLineMarkers 13
|
||||
#define chChartTypeSmoothLineStackedMarkers 15
|
||||
#define chChartTypeSmoothLineStacked100Markers 17
|
||||
#define chChartTypePie 18
|
||||
#define chChartTypePieExploded 19
|
||||
#define chChartTypePieStacked 20
|
||||
#define chChartTypeScatterMarkers 21
|
||||
#define chChartTypeScatterLine 25
|
||||
#define chChartTypeScatterLineMarkers 24
|
||||
#define chChartTypeScatterLineFilled 26
|
||||
#define chChartTypeScatterSmoothLine 23
|
||||
#define chChartTypeScatterSmoothLineMarkers 22
|
||||
#define chChartTypeBubble 27
|
||||
#define chChartTypeBubbleLine 28
|
||||
#define chChartTypeArea 29
|
||||
#define chChartTypeAreaStacked 30
|
||||
#define chChartTypeAreaStacked100 31
|
||||
#define chChartTypeDoughnut 32
|
||||
#define chChartTypeDoughnutExploded 33
|
||||
#define chChartTypeRadarLine 34
|
||||
#define chChartTypeRadarLineMarkers 35
|
||||
#define chChartTypeRadarLineFilled 36
|
||||
#define chChartTypeRadarSmoothLine 37
|
||||
#define chChartTypeRadarSmoothLineMarkers 38
|
||||
#define chChartTypeStockHLC 39
|
||||
#define chChartTypeStockOHLC 40
|
||||
#define chChartTypePolarMarkers 41
|
||||
#define chChartTypePolarLine 42
|
||||
#define chChartTypePolarLineMarkers 43
|
||||
#define chChartTypePolarSmoothLine 44
|
||||
#define chChartTypePolarSmoothLineMarkers 45
|
||||
#define chChartTypeColumn3D 46
|
||||
#define chChartTypeColumnClustered3D 47
|
||||
#define chChartTypeColumnStacked3D 48
|
||||
#define chChartTypeColumnStacked1003D 49
|
||||
#define chChartTypeBar3D 50
|
||||
#define chChartTypeBarClustered3D 51
|
||||
#define chChartTypeBarStacked3D 52
|
||||
#define chChartTypeBarStacked1003D 53
|
||||
#define chChartTypeLine3D 54
|
||||
#define chChartTypeLineOverlapped3D 55
|
||||
#define chChartTypeLineStacked3D 56
|
||||
#define chChartTypeLineStacked1003D 57
|
||||
#define chChartTypePie3D 58
|
||||
#define chChartTypePieExploded3D 59
|
||||
#define chChartTypeArea3D 60
|
||||
#define chChartTypeAreaOverlapped3D 61
|
||||
#define chChartTypeAreaStacked3D 62
|
||||
#define chChartTypeAreaStacked1003D 63
|
||||
ENDTEXT
|
||||
lnLines = ALINES(laLines, lcVar)
|
||||
FOR x = 1 TO lnLines
|
||||
lcValue = exTract(laLines(x)," ",CHR(13), ,.T.)
|
||||
INSERT INTO (lcCursorname) (naMe, id) VALUES ;
|
||||
(exTract(laLines(x),"#define "," "), VAL(lcValue))
|
||||
ENDFOR
|
||||
REPLACE naMe WITH STRTRAN(naMe, "chChartType", "") ALL
|
||||
ENDPROC
|
||||
*
|
||||
PROCEDURE SetGraphicsOptions
|
||||
LPARAMETER loChart
|
||||
RETURN
|
||||
ENDPROC
|
||||
*
|
||||
PROCEDURE nGraphType_Assign
|
||||
LPARAMETER lvGraphtype
|
||||
IF VARTYPE(lvGraphtype)="N"
|
||||
thIs.ngRaphtype = lvGraphtype
|
||||
RETURN
|
||||
ENDIF
|
||||
IF VARTYPE(lvGraphtype)="C"
|
||||
lvGraphtype = UPPER(lvGraphtype)
|
||||
DO CASE
|
||||
CASE lvGraphtype="BAR3D"
|
||||
thIs.ngRaphtype = 50
|
||||
CASE lvGraphtype="BAR"
|
||||
thIs.ngRaphtype = 0
|
||||
CASE lvGraphtype="PIE3D"
|
||||
thIs.ngRaphtype = 58
|
||||
CASE lvGraphtype="PIE"
|
||||
thIs.ngRaphtype = 18
|
||||
CASE lvGraphtype="PIEEXPLODED3D"
|
||||
thIs.ngRaphtype = 59
|
||||
CASE lvGraphtype="PIEEXPLODED"
|
||||
thIs.ngRaphtype = 19
|
||||
CASE lvGraphtype="COLUMN3D"
|
||||
thIs.ngRaphtype = 51
|
||||
CASE lvGraphtype="COLUMN"
|
||||
thIs.ngRaphtype = 3
|
||||
CASE lvGraphtype="LINE3D"
|
||||
thIs.ngRaphtype = 54
|
||||
CASE lvGraphtype="LINEPOINTS"
|
||||
thIs.ngRaphtype = 7
|
||||
CASE lvGraphtype="LINE"
|
||||
thIs.ngRaphtype = 6
|
||||
ENDCASE
|
||||
ENDIF
|
||||
ENDPROC
|
||||
*
|
||||
ENDDEFINE
|
||||
*
|
||||
DEFINE CLASS GraphForm AS Form
|
||||
shOwwindow = 2
|
||||
caPtion = "Graph Results"
|
||||
maXbutton = .F.
|
||||
boRderstyle = 2
|
||||
ENDDEFINE
|
||||
*
|
||||
FUNCTION IsCOMObject
|
||||
LPARAMETER lcProgid, lcClassid, lcClassdescript
|
||||
IF EMPTY(lcProgid)
|
||||
RETURN .F.
|
||||
ENDIF
|
||||
loApi = CREATEOBJECT("wwAPI")
|
||||
lcClassid = loApi.reAdregistrystring(-2147483648,lcProgid+"\CLSID","")
|
||||
IF ISNULL(lcClassid)
|
||||
lcClassid = ""
|
||||
lcClassdescription = ""
|
||||
RETURN .F.
|
||||
ENDIF
|
||||
lcClassdescript = loApi.reAdregistrystring(-2147483648,lcProgid,"")
|
||||
IF ISNULL(lcClassdescript)
|
||||
lcClassdescript = ""
|
||||
ENDIF
|
||||
RETURN .T.
|
||||
ENDFUNC
|
||||
|
||||
FUNCTION DeleteFiles
|
||||
PARAMETER lcFilespec, lnTimeout
|
||||
PRIVATE lnX, lnFiles, loApi
|
||||
lnTimeout = IIF(EMPTY(lnTimeout), 300, lnTimeout)
|
||||
lnFiles = ADIR(laFiles, lcFilespec)
|
||||
FOR lnX = 1 TO lnFiles
|
||||
ldTime = CTOT(DTOC(laFiles(lnX,3))+" "+laFiles(lnX,4))
|
||||
IF ldTime+lnTimeout<DATETIME()
|
||||
ERASE (ADDBS(JUSTPATH(lcFilespec))+laFiles(lnX,1))
|
||||
ENDIF
|
||||
ENDFOR
|
||||
RETURN .T.
|
||||
ENDFUNC
|
||||
BIN
COMUN/utile/web/wwxml.VCT
Normal file
BIN
COMUN/utile/web/wwxml.VCT
Normal file
Binary file not shown.
BIN
COMUN/utile/web/wwxml.VCX
Normal file
BIN
COMUN/utile/web/wwxml.VCX
Normal file
Binary file not shown.
192
COMUN/utile/web/wwxmlhttp.prg
Normal file
192
COMUN/utile/web/wwxmlhttp.prg
Normal file
@@ -0,0 +1,192 @@
|
||||
#DEFINE FLAG_ICC_FORCE_CONNECTION 0x01
|
||||
*!* http://www.mfinante.ro/contribuabili/link.jsp?body=/cod.do
|
||||
*!* cod=1879855
|
||||
Clear
|
||||
SET PROCEDURE TO D:\ROA_RB\ROACONT\COMUN\PROGRAME\OPROCEDURI_COMUNE.PRG ADDITIVE
|
||||
LOCAL lcResponse, lnResponse, loMyXMLHTTP
|
||||
|
||||
loHTTP = CREATEOBJECT("Microsoft.XMLHTTP")
|
||||
loHTTP.OPEN("POST", [http://www.mfinante.ro/contribuabili/link.jsp?body=/cod.do], .F.)
|
||||
loHTTP.setRequestHeader('Content-Type', 'application/x-www-form-urlencoded')
|
||||
|
||||
lcValues = "cod=18798551"
|
||||
loHTTP.SEND(lcValues)
|
||||
|
||||
lnStatus = loHTTP.STATUS
|
||||
lcResponse = UPPER(loHTTP.responseText)
|
||||
|
||||
lnLinii = ALines(laLines,lcResponse)
|
||||
|
||||
lcDenumire = laLines[670]
|
||||
lnPos1 = Rat('>',lcDenumire,3)
|
||||
lnPos2 = Rat('<',lcDenumire,2)
|
||||
lcDenumire = Substr(lcDenumire, lnPos1 + 1, lnPos2 - lnPos1 - 1)
|
||||
*MessageBox(lcDenumire)
|
||||
*!* MESSAGEBOX(lnStatus )
|
||||
*!* NU EXISTA AGENT ECONOMIC CU ACEST COD
|
||||
STRTOFILE(lcResponse,"c:\test.htm")
|
||||
OPEN_DEFAULT_APP("c:\test.htm")
|
||||
|
||||
DEFINE CLASS myXMLHTTP AS CUSTOM
|
||||
|
||||
oHTTP = NULL
|
||||
|
||||
cHost = ""
|
||||
nError = 0
|
||||
cError = ""
|
||||
|
||||
PROCEDURE INIT
|
||||
LPARAMETERS tcHost
|
||||
IF PCOUNT() = 1 AND TYPE('tcHost') = 'C' AND !EMPTY(tcHost)
|
||||
THIS.cHost = tcHost
|
||||
ENDIF
|
||||
*!* THIS.oHTTP = CREATEOBJECT("Microsoft.XMLHTTP")
|
||||
THIS.oHTTP = CREATEOBJECT("MSXML2.ServerXMLHTTP")
|
||||
|
||||
ENDPROC && init
|
||||
|
||||
FUNCTION CHECK_INTERNET
|
||||
|
||||
DECLARE INTEGER InternetCheckConnection IN wininet ;
|
||||
STRING lpszUrlSTRING, INTEGER dwFlags, INTEGER dwReserved
|
||||
|
||||
myHost = THIS.cHost
|
||||
|
||||
RETURN InternetCheckConnection(myHost,FLAG_ICC_FORCE_CONNECTION,0)
|
||||
ENDFUNC && CHECK_INTERNET
|
||||
|
||||
FUNCTION post
|
||||
LPARAMETERS tcValues, tcResponse
|
||||
|
||||
LOCAL lcValues, loHTTP, lcResponse, lnResponse
|
||||
LOCAL llAsincron
|
||||
llAsincron = .T.
|
||||
lnResponse = 1
|
||||
tcResponse = ""
|
||||
lcResponse = ""
|
||||
IF .F.
|
||||
* NU MAI VERIFIC CONEXIUNEA LA INTERNET - DACA ROUTERUL NU ARE INTERNET STA 21 SECUNDE SA VERIFICE :(
|
||||
* POSTEZ EROAREA ASINCRON - DACA ARE INTERNET O TRIMITE
|
||||
lnCheckInternet = THIS.CHECK_INTERNET()
|
||||
IF lnCheckInternet <= 0
|
||||
RETURN
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF EMPTY(THIS.cHost)
|
||||
RETURN
|
||||
ENDIF
|
||||
IF TYPE('this.oHTTP') = "O"
|
||||
loHTTP = THIS.oHTTP
|
||||
lcHost= THIS.cHost
|
||||
|
||||
loHTTP.OPEN("POST", lcHost, llAsincron)
|
||||
loHTTP.setRequestHeader('Content-Type', 'application/x-www-form-urlencoded')
|
||||
|
||||
lcValues = tcValues
|
||||
loHTTP.SEND(lcValues)
|
||||
|
||||
IF .F.
|
||||
*!* DACA FOLOSESC XMLHTTP ASINCRON TREBUIE SA ASTEPT READYSTATE = 4 IN DO WHILE
|
||||
lnStatus = loHTTP.STATUS
|
||||
tcResponse = UPPER(loHTTP.responseText)
|
||||
lnResponse = IIF('SUCCES'$tcResponse,1,-1)
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
RETURN lnResponse
|
||||
|
||||
ENDFUNC && post
|
||||
|
||||
FUNCTION postError
|
||||
LPARAMETERS tcErrorMsg, tcUserName, tcProgram, tcVersion, tcDatabaseUser
|
||||
|
||||
LOCAL lcValues, lcError, lcUserName, lcProgram, lnResponse, lcVersion, lcDatabaseUser
|
||||
LOCAL laVersion
|
||||
DIMENSION laVersion[12]
|
||||
|
||||
lcError = ALLTRIM(TRANSFORM(tcErrorMsg))
|
||||
lcUserName = ALLTRIM(TRANSFORM(tcUserName))
|
||||
lcProgram = ALLTRIM(TRANSFORM(tcProgram))
|
||||
|
||||
IF EMPTY(tcVersion) OR TYPE('tcVersion') <> 'C'
|
||||
lnVersion = AGETFILEVERSION(laVersion, SYS(16,0))
|
||||
IF lnVersion >= 4
|
||||
lcVersion = laVersion[4]
|
||||
ELSE
|
||||
lcVersion = ""
|
||||
ENDIF
|
||||
ELSE
|
||||
lcVersion = ALLTRIM(tcVersion)
|
||||
ENDIF
|
||||
|
||||
IF EMPTY(tcDatabaseUser) OR TYPE('tcDataBaseUser') <> 'C'
|
||||
*!* modificare ROASTART v 2.0.29
|
||||
*!* lcDatabaseUser = IIF(TYPE('gcs') = 'C', gcS, "")
|
||||
lcDatabaseUser = IIF(TYPE('gcs') = 'C', gcS, IIF(TYPE('gcHost') = 'C',gcHost, ""))
|
||||
*!* modificare ROASTART v 2.0.29 ^
|
||||
ELSE
|
||||
lcDatabaseUser = tcDatabaseUser
|
||||
ENDIF
|
||||
|
||||
lcError = THIS.urlencode(lcError)
|
||||
|
||||
lcValues = "error[errormsg]=" + lcError + "&error[username]=" + lcUserName + "&error[program]=" + lcProgram + ;
|
||||
"&error[version]=" + lcVersion + "&error[databaseuser]=" + lcDatabaseUser
|
||||
|
||||
lnResponse = THIS.post(lcValues)
|
||||
|
||||
RETURN lnResponse
|
||||
|
||||
ENDFUNC && postError
|
||||
|
||||
PROCEDURE ERROR
|
||||
LPARAMETERS nError,cMethod,nLine
|
||||
|
||||
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)
|
||||
lcErrorMsg=lcErrorMsg+"Method: "+cMethod
|
||||
lcCodeLineMsg=MESSAGE(1)
|
||||
IF BETWEEN(nLine,1,10000) AND NOT lcCodeLineMsg="..."
|
||||
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
||||
IF NOT EMPTY(lcCodeLineMsg)
|
||||
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
MESSAGEBOX(lcErrorMsg)
|
||||
|
||||
ENDPROC && error
|
||||
|
||||
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
|
||||
|
||||
ENDDEFINE
|
||||
Reference in New Issue
Block a user