************************************************************************
* FUNCTION Utils
******************
***    Author: Rick Strahl
***            (c) West Wind Technologies, 1995-98
***   Contact: (541) 386-2087  / rstrahl@west-wind.com
***  Modified: 12/22/97
***  Function: A set of utility classes and functions used by 
***            the various classes and processing code.
*************************************************************************
#INCLUDE FOXPRO.H
#INCLUDE WCONNECT.H

SET PROCEDURE TO wwUtils ADDITIVE


*************************************************************
DEFINE CLASS wwEnv AS Custom
*************************************************************
***  Function: Saves environment settings.
*************************************************************

*** Custom Properties
PROTECTED cSetting,vOldValue


************************************************************************
* wwEnv :: Init
*********************************
***  Function: Saves and restores environment settings
***    Assume: Limited to simple ON/OFF settings
***            Very limited!!! Test carefully.
***      Pass: tcSetting  -   SET value to set
***            tvNewValue -   Value to set to
***    Return:
************************************************************************
FUNCTION Init
LPARAMETERS tcSetting,tvNewValue
THIS.Set(tcSetting, tvNewValue)
ENDFUNC
* Init

************************************************************************
* wwEnv :: Set
*********************************
FUNCTION Set
LPARAMETERS tcSetting,tvNewValue
THIS.cSetting=tcSetting

THIS.vOldValue=SET( tcSetting )

IF TYPE("tvNewValue")="C" AND ;
   INLIST(UPPER(tvNewValue),"ON","OFF") 
   SET &tcSetting &tvNewValue
ELSE
   SET &tcSetting TO (tvNewValue)   
ENDIF

ENDFUNC
* Set
************************************************************************
* wwEnv :: Destroy
*********************************
FUNCTION Destroy
LOCAL lcSetting,lvValue

lcSetting=THIS.cSetting
lvValue=THIS.vOldValue

IF TYPE("lvValue")="C" AND ;
   INLIST(UPPER(lvValue),"ON","OFF") 
   SET &lcSetting &lvValue
ELSE
   SET &lcSetting TO (lvValue)   
ENDIF

ENDFUNC
* Destroy

ENDDEFINE
*EOC wwEnv


#IF .F.
*DEFINE CLASS wwUtils as Custom
#ENDIF


*************************************************************************
****
**** STANDALONE FUNCTIONS
****
*************************************************************************

************************************************************************
FUNCTION OpenExclusive
**********************
***  Modified: 01/27/96
***  Function: Tries to open a table exclusively
***    Assume: Table name can't contain a file name.
***            Returns .F. for other reasons like file !found etc.
***            USES wwEVAL object to test for success
***            Parameters MUST NOT BE LPARAMETERS!!!
***      Pass: lcTable   -  Name of table to open exclusively
***    Return: .T. or .F.
************************************************************************
PARAMETERS lcTable, lcAlias
LOCAL lcOldError, llRetVal, loEval

lcTable=IIF(EMPTY(lcTable),"",lcTable)
lcAlias=IIF(EMPTY(lcAlias),JustStem(lcTable),lcAlias)

IF EMPTY(lcTable)
   RETURN .F.
ENDIF

loEval=CREATE([WWC_wwEval])

*** Use Exclusively to reindex and pack
IF !USED(lcAlias)
   loEval.ExecuteCommand("USE (lcTable) EXCLUSIVE IN 0 ALIAS (lcAlias)")
ELSE
   SELE (lcAlias)
   loEval.ExecuteCommand("USE (lcTable) EXCLUSIVE  ALIAS (lcAlias)")
ENDIF

llRetVal=!loEval.lError

*** Now try to re-open table as shared
IF !llRetVal
   USE (lcTable) IN 0 ALIAS(lcAlias)
ELSE
   SELE (lcAlias)   
ENDIF   

RETURN llRetVal
*EOP OpenExclusive


************************************************************************
FUNCTION File2Var
******************
***  Function: Takes a file and returns the contents as a string or
***            Takes a string and stores it in a file if a second
***            string parameter is specified.
***      Pass: tcFilename  -  Name of the file
***            tcString    -  If specified the string is stored
***                           in the file specified in tcFileName
***    Return: file contents as a string
************************************************************************
LPARAMETERS tcFileName, tcString
LOCAL lcRetVal, lnHandle, lnSize

tcFileName=IIF(EMPTY(tcFileName),"",tcFileName)

IF VARTYPE(tcString) # "C"
   *** File to Text
   lcRetVal=""
   
   *** Make sure file exists and can be opened for READ operation
   lnHandle=FOPEN(tcFileName,0)
   IF lnHandle#-1
     lnSize = FSEEK(lnHandle,0,2)
     FSEEK(lnHandle,0,0)
     lcRetVal=FREAD(lnHandle,lnSize)
     =FCLOSE(lnHandle)
   ENDIF
ELSE
   tcString=IIF(EMPTY(tcString),"",tcString)
   
   *** Text to File
   lnHandle=FCREATE(tcFileName)
   IF lnHandle=-1
      RETURN .F.
   ENDIF
   =FWRITE(lnHandle,tcString)
   =FCLOSE(lnHandle)
   RETURN .T.
ENDIF

RETURN lcRetVal
*EOP File2Var

************************************************************************
FUNCTION Extract
******************
***  Function: Extracts a text value between two delimiters
***    Assume: Delimiters case insensitive
***            The first instance only is retrieved. Idea is
***            to translate the delims as you go...
***      Pass: lcString   -  Entire string
***			   lcDelim1   -  The starting delimiter
***            lcDelim2	  -  Ending delimiter
***            lcDelim3	  -  Alternate ending delimiter
***            llEndOk	  -  End of line is OK
***    Return: Text between delimiters or ""
*************************************************************************
PARAMETERS lcString,lcDelim1,lcDelim2,lcDelim3, llEndOk
PRIVATE lnX,lnLocation,lcRetVal,lcChar,lnNewString,lnEnd

#IF wwVFPVersion > 6
   IF EMPTY(lcDelim3) 
      RETURN STREXTRACT(lcString,lcDelim1,lcDelim2,1,1 + IIF(llendOk,2,0) )
   ENDIF
#ENDIF

lcDelim1=IIF(LEN(lcDelim1)=0,",",lcDelim1)
lcDelim2=IIF(LEN(lcDelim2)=0,"z!x",lcDelim2)
lcDelim3=IIF(EMPTY(lcDelim3),"z!x",lcDelim3)

lnLocation=ATC(lcDelim1,lcString)
IF lnLocation=0
   RETURN ""
ENDIF

lnLocation=lnlocation+len(lcDelim1)

*** Crate a new string of remaining text
lcNewString=SUBSTR(lcString,lnLocation)

lnEnd=ATC(lcDelim2,lcNewString)
IF lnEnd>0
   RETURN SUBSTR(lcNewString,1,lnEnd-1)
ENDIF   
*!*	IF lnEnd = 0
*!*	   *** Empty Delimited string
*!*	   RETURN ""
*!*	ENDIF
   
lnEnd=ATC(lcDelim3,lcNewString)
IF lnEnd>0
   RETURN SUBSTR(lcNewString,1,lnEnd-1)
ENDIF   

IF llEndOk
  *** Return to the end of the line
  RETURN SUBSTR(lcNewString,1)
ENDIF

RETURN ""
*EOP RetValue

************************************************************************
* wwUtils :: ReplaceDelimitedText
****************************************
***  Function: Replaces text between a set of delimiters with 
***            a new string leaving the delimiters intact
***    Assume: The delimited block MUST have at least 1 character
***            in it even if it is blank or a CRLF
***      Pass: lcSource - Full Source String
***            lcStart  - Start delimiter
***            lcEnd    - End Delimiter
***            lcReplace -  Text to replace between delimiters
***    Return: Updated String  
************************************************************************
FUNCTION ReplaceText
LPARAMETERS lcSource, lcStart, lcEnd, lcReplace

lcExtract = Extract(lcSource,lcStart,lcEnd,,.T.)
  
RETURN STRTRAN(lcSource,lcStart + lcExtract + lcEnd,lcStart + lcReplace + lcEnd)
ENDFUNC


************************************************************************
FUNCTION Path
******************
***  Function: Adds or deletes items from the path string
***      Pass: pcPathName   -   Filename
***            pcMethod     -   *"ADD","DELETE"
***    Return: New Path or ""
************************************************************************
PARAMETERS pcPath,pcMethod
LOCAL lcOldPath

IF VARTYPE(pcMethod) # "C"
   pcMethod = "ADD"
ENDIF

IF EMPTY(pcPath)
   RETURN
ENDIF
   
pcPath=ADDBS(LOWER(TRIM(pcPath)))
lcOldPath=LOWER(SET("PATH"))

IF pcMethod="ADD"
    IF EMPTY(pcPath) .OR. ;
       !Directory(pcPath)
       RETURN ""
   ENDIF
   IF AT(";" + pcPath + ";" ,";" + lcOldPath + ";")>0
      RETURN ""
   ENDIF
   lcOldPath=lcOldPath+";"+pcPath
ELSE
   IF AT(";" + pcPath + ";" ,";" + lcOldPath + ";") < 1
      RETURN ""
   ENDIF
   lcOldPath=STRTRAN(lcOldPath + ";" ,";" +pcPath+";",";")
   lcOldPath = SUBSTR(lcOldPath,1,LEN(lcOldPath)-1)
ENDIF   

SET PATH TO &lcOldPath

RETURN lcOldPath
*EOP PATH


************************************************************************
FUNCTION DomainName
*******************
***  Modified: 04/13/96
***  Function: Retrieves a Domain name from an URL
***    Assume: URL starts with http:// - // required!
***      Pass: lcUrl         -  URL to retrieve name from
***            llNoStripWWW  -  Don't strip www.
***    Return: Domain Name or ""
*************************************************************************
LPARAMETER lcUrl, llNoStripWWW
lcText=STRTRAN(EXTRACT(lower(lcUrl),"//","/"," "),"/","")
IF !llNoStripWWW
  lcText=STRTRAN(lcText,"www.","")
ENDIF
RETURN PADR(lcText,50)



************************************************************************
FUNCTION ShowHTML
*****************
***  Function: Takes an HTML string and displays it in the default
***            browser. 
***    Assume: Uses a file to store HTML temporarily.
***            For this reason there may be concurrency issues
***            unless you change the file for each use
***      Pass: lcHTML       -   HTML to display
***            lcFile       -   Temporary File to use (Optional)
***            loWebBrowser -   Web Browser control ref (Optional)
************************************************************************
LPARAMETERS lcHTML, lcFile, loWebBrowser

lcHTML=IIF(EMPTY(lcHTML),"",lcHTML)
lcFile=IIF(EMPTY(lcFile),SYS(2023)+"\ww_HTMLView.htm",lcFile)

File2Var(lcFile,lcHTML)

IF TYPE("loWebBrowser") = "O"
   loWebBrowser.Navigate(lcFile)
ELSE
   IF TYPE("_oscreenx") = "O"
      _oscreenx.Navigate(lcFile)
   ENDIF
*!*	   IF lower(JUSTEXT(lcFile)) = "txt"
*!*	      MODI COMM (lcFile) IN MACDESKTOP
*!*	   ELSE
      =GoUrl(lcFile)
*!*	   ENDIF
ENDIF   

RETURN
*EOP ShowHTML

************************************************************************
FUNCTION ShowXML
*****************
***  Function: Takes an XML string and displays it in the default
***            browser. 
***    Assume: Uses a file to store HTML temporarily.
***            For this reason there may be concurrency issues
***            unless you change the file for each use
***      Pass: lcHTML       -   HTML to display
***            lcFile       -   Temporary File to use (Optional)
***            loWebBrowser -   Web Browser control ref (Optional)
************************************************************************
LPARAMETERS lcHTML, lcFile, loWebBrowser
IF EMPTY(lcFile)
  lcFile=IIF(EMPTY(lcFile),SYS(2023)+"\ww_HTMLView.xml",lcFile)
ENDIF
ERASE (lcFile) 
RETURN ShowHTML(lcHTML,lcFile,loWebBrowser)

************************************************************************
FUNCTION ShowText
*****************
***  Function: Takes an XML string and displays it in the default
***            browser. 
***    Assume: Uses a file to store HTML temporarily.
***            For this reason there may be concurrency issues
***            unless you change the file for each use
***      Pass: lcHTML       -   HTML to display
***            lcFile       -   Temporary File to use (Optional)
***            loWebBrowser -   Web Browser control ref (Optional)
************************************************************************
LPARAMETERS lcHTML, lcFile, loWebBrowser
IF EMPTY(lcFile)
  lcFile=IIF(EMPTY(lcFile),SYS(2023)+"\ww_HTMLView.txt",lcFile)
ENDIF

IF VARTYPE(loWebBrowser) = "C" and loWebBrowser = "MODI"
   FILE2VAR(lcFile,lcHTML)
   MODIFY COMMAND (lcFile)
   RETURN
ENDIF   

RETURN ShowHTML(lcHTML,lcFile,loWebBrowser)


************************************************************************
FUNCTION IsWinnt
*****************
***      Pass: llReturnVersionNumber
***    Return: .t. or .f.   or Version Number or -1 if not NT
*************************************************************************
LPARAMETER llReturnVersionNumber

loAPI=CREATE("wwAPI")
lcVersion = loAPI.ReadRegistryString(HKEY_LOCAL_MACHINE,;
           "SOFTWARE\Microsoft\Windows NT\CurrentVersion",;
           "CurrentVersion")
                          
IF !llReturnVersionNumber
  IF ISNULL(lcVersion)
     RETURN .F.
  ELSE
     RETURN .T.
  ENDIF
ENDIF

IF ISNULL(lcVersion)
   RETURN -1
ENDIF

RETURN VAL(lcVersion)   
* IsWinNt



************************************************************************
FUNCTION StripHTML
*******************
***  Function: Removes HTML tags from the passed text and converts
***            it to plain text. Note formatting is totally removed!
***    Assume: only <br> and <p> are translated
***            any < or > in the HTML besides tags will break this
***            function.
***      Pass: lcText  -   HTML Text to strip
***            lcLTag  -   Left Tag value ("<")
***            lcRTag  -   Right Tag Value (">")
***    Return: Stripped HTML text
*************************************************************************
LPARAMETER lcHTMLText, lcLTag, lcRTag

lcLTag=IIF(EMPTY(lcLTag),"<",lcLTag)
lcRTag=IIF(EMPTY(lcRTag),">",lcRTag)

IF ATC(lcLTag,lcHTMLText) = 0
   RETURN lcHTMLText
ENDIF

*** Start by breaking line breaks
lcHTMLText = STRTRAN(lcHTMLText,lcLTag + "BR" + lcRTag,CRLF)
lcHTMLText = STRTRAN(lcHTMLText,lcLTag + "P" + lcRTag,CRLF+CRLF)
lcHTMLText = STRTRAN(lcHTMLText,lcLTag + "br" + lcRTag,CRLF)
lcHTMLText = STRTRAN(lcHTMLText,lcLTag + "p" + lcRTag,CRLF+CRLF)
lcHTMLText = STRTRAN(lcHTMLText,"&nbsp;"," ")

lcExtract = "x"   
DO WHILE !EMPTY(lcExtract)
   lcExtract = Extract(lcHTMLText,lcLTag,lcRTag)

   IF EMPTY(lcExtract)
      EXIT
   ENDIF
   lcHTMLText = STRTRAN(lcHTMLText,lcLTag+lcExtract+lcRTag,"")
ENDDO

lcHTMLText = STRTRAN(lcHTMLText,"&lt;","<")
lcHTMLText = STRTRAN(lcHTMLText,"&gt;",">")

RETURN lcHTMLText

************************************************************************
FUNCTION HTMLColor
*********************************
***  Function: Converts a FoxPro Color to an HTML Hex color value
***      Pass: lnRGBColor   -  FoxPro RGB color number - RGB(255,255,255)
***            llNoOutput
***    Return: Hex HTML Color String "#FFFFFF"
************************************************************************
LPARAMETER lnRGBColor

lcColor=RIGHT(TRANSFORM(lnRGBColor,"@0"),6)

*** Fox color is BBGGRR, HTML is RRGGBB

RETURN "#" + SUBSTR(lcColor,5,2) + SUBSTR(lcColor,3,2) + LEFT(lcColor,2)
* HTMLColor


************************************************************************
FUNCTION CharToBin
******************
***  Function: Converts a DWORD value in binary string form back into
***            a numeric value
***      Pass: tcWord  -    Binary string value (from a structure?)
***    Return: numeric value of binary string
*************************************************************************
LPARAMETER tcWord

  LOCAL i, lnWord

  lnWord = 0
  FOR i = 1 TO LEN(tcWord)
    lnWord = lnWord + (ASC(SUBSTR(tcWord, i, 1)) * (2 ^ (8 * (i - 1))))
  ENDFOR

RETURN lnWord


****************************************************
FUNCTION GoUrl
******************
***    Author: Rick Strahl
***            (c) West Wind Technologies, 1996
***   Contact: rstrahl@west-wind.com
***  Modified: 03/14/96
***  Function: Starts associated Web Browser
***            and goes to the specified URL.
***            If Browser is already open it
***            reloads the page.
***    Assume: Works only on Win95 and NT 4.0
***      Pass: tcUrl  - The URL of the site or
***                     HTML page to bring up
***                     in the Browser
***    Return: 2  - Bad Association (invalid URL)
***            31 - No application association
***            29 - Failure to load application
***            30 - Application is busy 
***
***            Values over 32 indicate success
***            and return an instance handle for
***            the application started (the browser) 
****************************************************
LPARAMETERS tcUrl, tcAction, tcDirectory

tcUrl=IIF(type("tcUrl")="C",tcUrl,;
          "http://www.west-wind.com/")
          
tcAction=IIF(type("tcAction")="C",tcAction,"OPEN")

tcDirectory=IIF(EMPTY(tcDirectory),SYS(2023),tcDirectory)

DECLARE INTEGER ShellExecute ;
    IN SHELL32.dll ;
    INTEGER nWinHandle,;
    STRING cOperation,;
    STRING cFileName,;
    STRING cParameters,;
    STRING cDirectory,;
    INTEGER nShowWindow

DECLARE INTEGER FindWindow ;
   IN WIN32API ;
   STRING cNull,STRING cWinName

RETURN ShellExecute(FindWindow(0,_SCREEN.caption),;
                    tcAction,tcUrl,;
                    "",tcDirectory,1)

************************************************************************
PROCEDURE StrTranC
******************
***  Function: Like Strtran but case insensitive
***      Pass: lcString   -  Entire string
***			   lcDelim1   -  String to replace
***            lcDelim2	  -  String to replace with
***    Return: translated string
*************************************************************************
LPARAMETER lcString, lcSource, lcReplace

#IF wwVFPVersion > 6
  RETURN STRTRAN(lcString,lcSource,lcReplace,1,-1,1)
#ELSE
LOCAL lnAt

lnAt = 1
lnReplaceSize = LEN(lcSource)
DO while .T.
   lnAt = ATC(lcSource,lcString)
   IF lnAT = 0
      RETURN lcString
   ENDIF
   
   lcString = STUFF(lcString,lnAt,lnReplaceSize,lcReplace)
ENDDO

RETURN lcString
#ENDIF


FUNCTION TimeToCStrict
LPARAMETER ltTime, llSQL

lcCentury = SET("CENTURY")
lcDateMode = SET("DATE")
SET CENTURY ON
SET DATE TO YMD

IF llSQL
  lcDate = "'" + TTOC(ltTime) + "'"
ELSE
  lcDate = "{^" + TTOC(ltTime) + "}"
ENDIF

SET DATE TO &lcDateMode
SET CENTURY &lcCentury
RETURN lcDate

************************************************************************
FUNCTION DateToC
******************
***  Function: Converts a date to string displaying empty dates as blanks
***            rather than displaying the empty date format
***      Pass: ldDate  - Date to display
***    Return: Date String or "" if invalid date
*************************************************************************
LPARAMETER ldDate

IF EMPTY(ldDate)
   RETURN ""
ENDIF

RETURN  DTOC(ldDate)
* DateTOC



************************************************************************
FUNCTION TimeToC
******************
***  Function: Converts a time to string displaying empty  as blanks
***            and formatting the time string properly
***      Pass: ltTime  - Date to display (Pass Time, Date or Char)
***    Return: Time String or "" if invalid date (Year is not returned)
*************************************************************************
LPARAMETER ltTime

IF EMPTY(ltTime)
   RETURN ""
ENDIF

IF VARTYPE(ltTime) $ "DT"
  lcTimestamp = TTOC(ltTime)
ELSE
  lcTimeStamp = ltTime  
ENDIF  

RETURN  Substr(lcTimeStamp,1,5)+"/" + Substr(lcTimeStamp,9,8)+lower(Substr(lcTimeStamp,21,2))
* DateTOC

************************************************************************
FUNCTION GetAppStartPath
*********************************
***  Function: Returns the FoxPro start path
***            of the *APPLICATION*
***            under all startmodes supported by VFP.
***            Returns the path of the starting EXE, 
***            DLL, APP, PRG/FXP
***    Return: Path as a string with trailing "\"
************************************************************************

DO CASE 
   *** VFP 6 provides ServerName property for COM servers EXE/DLL/MTDLL
   CASE INLIST(Application.StartMode,2,3,5) 
         lcPath = JustPath(Application.ServerName)

*!*	   *** Interactive
*!*	   CASE (Application.StartMode) = 0
*!*	         lcPath = SYS(5) + CURDIR()
         
   *** Active Document
   CASE ATC(".APP",SYS(16,0)) > 0
       lcPath = JustPath(SYS(16,0))

  *** Standalone EXE or VFP Development
  OTHERWISE
       lcPath = JustPath(SYS(16,0))
       IF ATC("PROCEDURE",lcPath) > 0
         lcPath = SUBSTR(lcPath,RAT(":",lcPath)-1)
       ENDIF
ENDCASE

RETURN AddBs(lcPath)
* EOF GetAppStartPath      


************************************************************************
FUNCTION ShortPath
******************
***  Function: Converts a Long Windows filename into a short
***            8.3 compliant path/filename
***      Pass: lcPath   -  Path to check
***    Return: lcShortFileName
*************************************************************************
LPARAMETER lcPath

DECLARE INTEGER GetShortPathName IN Win32API;
  STRING @lpszLongPath,	STRING @lpszShortPath,;
  INTEGER cchBuffer

lcPath = lcPath
lcshortname = SPACE(260)
lnlength = LEN(lcshortname)
lnresult = GetShortPathName(@lcPath, @lcshortname, lnlength)
IF lnResult = 0
   RETURN ""
ENDIF
RETURN LEFT(lcShortName,lnResult)


************************************************************************
FUNCTION DeleteFiles
********************
***  Function: Returns the size of a file
***      Pass: lcFileName   - Wildcard File Spec  (d:\temp\*.pdf)
***            lnTimeout    - Timeout in seconds 
***    Return: the size of the file or -1 on error
************************************************************************
PARAMETERS lcFileSpec, lnTimeout
PRIVATE lnX,lnFiles, loAPI

lnTimeout=IIF(EMPTY(lnTimeout),300,lnTimeout)

lnFiles = aDir(laFiles,lcFileSpec)
*loEval = CREATE([WWC_wwEval])
FOR lnX=1 to lnFiles
   ldtime = CTOT( DTOC(laFiles[lnX,3]) + " " + laFiles[lnX,4] )
   IF  ldTime + lnTimeout < DateTime()
 *     loEval.ExecuteCommand( " ERASE (ADDBS(justpath(lcFileSpec)) + laFiles[lnX,1]) " )
     ERASE (ADDBS(justpath(lcFileSpec)) + laFiles[lnX,1]) 
   ENDIF
ENDFOR

RETURN .T.
ENDFUNC


************************************************************************
FUNCTION IsDir
******************
***  Modified: 10/09/97
***  Function: Checks to see whether a directory exists
***      Pass: lcPath   -  Path to check
***    Return: .T. or .F.
*************************************************************************
LPARAMETER lcPath
DIMENSION laTemp[1]
IF ADIR(laTemp,lcPath,"DH") < 1
   RETURN .F.
ENDIF
RETURN .T.

************************************************************************
FUNCTION FileSize
******************
***  Function: Returns the size of a file
***      Pass: lcFileName
***    Return: the size of the file or -1 on error
************************************************************************
LPARAMETERS lcFileName
LOCAL lh, lnSize

lh = FOPEN(lcFileName)
IF lh = -1
   RETURN -1
ENDIF

lnSize = FSEEK(lh, 0, 2)   

FCLOSE(lh)

RETURN lnSize
*EOP FileSize


************************************************************************
FUNCTION Slash
******************
***  Function: Converts slashes from DOS -> Web and vice versa
***      Pass: lcPath   -  Path to convert
***            lcStyle  -  "WEB" or "DOS"
***    Return: update path
************************************************************************
LPARAMETER lcPath, lcStyle
lcStyle=IIF(type("lcStyle")="C",UPPER(lcStyle),"")
IF lcStyle="WEB"
   lcPath=CHRTRAN(lcPath,"\","/")
ELSE
   lcPath=CHRTRAN(lcPath,"/","\")
ENDIF
RETURN lcPath
*EOP LPARAMETER



************************************************************************
FUNCTION ProgLevel
******************
***  Function: Returns the current Calling Stack level. Used to check
***            recursive Error calls in Error methods.
*************************************************************************

FOR lnX=1 to 128
   IF EMPTY(SYS(16,lnX))
      exit
   ENDIF
ENDFOR && lnX=1 to 128

*** -1 for lnX count - -1 for ProgLevel Call
RETURN lnX - 2


************************************************************************
FUNCTION AParseString
**********************
***  Modified: 07/03/97
***  Function: Parses a delimited string into an array
***      Pass: laResult    -   Array containing the result strings (@)
***            lcString    -   The full string
***            lcDelimiter -   The delimiter string
***    Return: Count of strings or 0 if null string is passed
*************************************************************************
LPARAMETER laResult, lcString, lcDelimiter
LOCAL lnLastPos, lnItemCount, i

lnItemCount = OCCURS(lcDelimiter,lcString) + 1
DIMENSION laResult[lnItemCount]

lnLastPos=1

FOR i=1 to lnItemCount
   IF i < lnItemCount
     laResult[i] = SUBSTR(lcString,lnLastPos, ;
                          ATC(lcDelimiter,lcString,i) - lnLastPos )
   ELSE
     laResult[i] = SUBSTR(lcString,lnLastPos)
   ENDIF
   lnLastPos = ATC(lcDelimiter,lcString,i) + LEN(lcDelimiter)
ENDFOR

RETURN lnItemCount

************************************************************************
FUNCTION URLDecode
******************
***  Function: URLDecodes a text string to normal text.
***    Assume: Uses wwIPStuff.dll
***      Pass: lcText    -   Text string to decode
***    Return: Decoded string or ""
************************************************************************
LPARAMETERS lcText
LOCAL lnSize, lnLoc, lcHex, lcRetval

*** Use wwIPStuff for large buffers
IF LEN(lcText) > 255
   DECLARE INTEGER URLDecode ;
      IN WWIPSTUFF AS API_URLDecode ;
      STRING @cText

   lnSize=API_URLDecode(@lcText)

   IF lnSize > 0
      lcText = SUBSTR(lcText,1,lnSize)
   ELSE
      lcText = ""
   ENDIF

   RETURN lcText
ENDIF

*** First convert + to spaces
lcText=STRTRAN(lcText,"+"," ")

*** Handle Hex Encoded Control chars

lcRetval = ""
DO WHILE .T.
   *** Format: %0A  ( CHR(10) )
   lnLoc = AT('%',lcText)

   *** No Hex chars
   IF lnLoc > LEN(lcText) - 2 OR lnLoc < 1
      lcRetval = lcRetval + lcText
      EXIT
   ENDIF

   *** Now read the next 2 characters
   *** Check for digits - at this point we must have hex pair!
   lcHex=SUBSTR(lcText,lnLoc+1,2)

   *** Now concat the string plus the evaled hex code
   lcRetval = lcRetval + LEFT(lcText,lnLoc-1) + ;
      CHR( EVAL("0x"+lcHex) )

   *** Trim out the input string
   IF LEN(lcText) > lnLoc + 2
      lcText = SUBSTR(lcText,lnLoc+3)
   ELSE
      EXIT
   ENDIF
ENDDO

RETURN lcRetval
ENDFUNC
* EOF URLDecode

************************************************************************
FUNCTION GetURLEncodedKey
*********************************
***  Function: Retrieves a 'parameter' from the query string that
***            is encoded with standard CGI/ISAPI URL encoding.
***            Typical URL encoding looks like this:
***
***    "User=Rick+Strahl&ID=0011&Address=400+Morton%0A%0DHood+River"
***
***      Pass: lcVal   -   Form Variable to retrieve
***    Return: Value or ""
************************************************************************
LPARAMETERS tcURLString, lcKey
LOCAL lnLoc,c2, cStr, lcURLString, lcRetval

lcURLString=IIF(EMPTY(tcURLString),"","&"+tcURLString)
lcKey=IIF(EMPTY(lcKey),"  ",lcKey)
lcKey=STRTRAN(lcKey," ","+")

#IF wwVFPVersion > 6
	lcRetval = STREXTRACT(lcUrlString,"&"+lcKey+"=","&",1,3)
#ELSE
    lcRetval=Extract(@lcUrlString,"&"+lcKey+"=","&",,.T.)
#ENDIF

RETURN URLDecode(lcRetval)
ENDFUNC


********************************************************
FUNCTION URLEncode
*******************
***  Function: Encodes a string in URL encoded format
***            for use on URL strings or when passing a
***            POST buffer to wwIPStuff::HTTPGetEx
***      Pass: tcValue  -   String to encode
***    Return: URLEncoded string or ""
********************************************************
LPARAMETER tcValue
LOCAL lcResult, lcChar, lnSize, lnX

*** Large Buffers use the wwIPStuff function 
*** for quicker response
if LEN(tcValue) > 255
   lnSize=LEN(tcValue)
   tcValue=PADR(tcValue,lnSize * 3)

   DECLARE INTEGER VFPURLEncode ;
      IN WWIPSTUFF ;
      STRING @cText,;
      INTEGER cInputTextSize
   
   lnSize=VFPUrlEncode(@tcValue,lnSize)
   
   IF lnSize > 0
      RETURN SUBSTR(TRIM(tcValue),1,lnSize)
   ENDIF
   RETURN ""
ENDIF   
   
*** Do it in VFP Code
lcResult=""

FOR lnX=1 to len(tcValue)
   lcChar = SUBSTR(tcValue,lnX,1)
   IF ATC(lcChar,"ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789") > 0
      lcResult=lcResult + lcChar
      LOOP
   ENDIF
   IF lcChar=" "
      lcResult = lcResult + "+"
      LOOP
   ENDIF
   *** Convert others to Hex equivalents
   lcResult = lcResult + "%" + RIGHT(transform(ASC(lcChar),"@0"),2)
ENDFOR && lnX=1 to len(tcValue)

RETURN lcResult
* EOF URLEncode

#IF WWC_COMPATIBILITY
************************************************************************
FUNCTION WCSCompile
*******************
***  Modified: 12/31/97
***  Function: Compiles WCS script files
***    Assume: Requires Runtime version
***            Called by wwMaint using VisualFoxpro.Application
***            Automation object if Runtime is installed.
***      Pass: lcFileSpec    -   Filespec of files to compile
***            llSilent      -   No error display
***    Return: "" on success or Error String
*************************************************************************
LPARAMETER lcFileSpec, llSilent
lcFileSpec=IIF(type("lcFileSpec")="C",lcFileSpec,CURDIR() + "*.wcs")

lcPath = justpath(lcFileSpec)
lcFile = justfname(lcFileSpec)

IF EMPTY(lcPath)
  lcPath = CURDIR()
ENDIF
IF EMPTY(lcFile)
  lcFile = "*.WCS"
ENDIF
lcPath = ADDBS(lcPath)

lcFileSpec = lcPath + lcFile


DIMENSION laFiles[1]
lnFiles = ADIR(laFiles,lcFileSpec)
IF lnFiles < 1
   RETURN "No files to compile..."
ENDIF
oScript = CREATE("wwVFPScript",laFiles[1])
IF TYPE("oScript") <> "O"
  Return "Error: Couldn't create wwVFPScriptObject"
ENDIF
oScript.lDeleteGeneratedCode = .F.   && Erase WCT files

FOR lnX = 1 to lnFiles
         lcFileName = lcPath+laFiles[lnX,1]
         wait window nowait "Compiling "+lcFileName
         
         *** WCS - Script Text   WCX - Compiled   WCT - Intermediate
         oScript.cFileName = lcFileName
         oScript.ConvertPage()
         oScript.CompilePage() 
ENDFOR

wait window nowait LTRIM(STR(lnFiles))+ " Web Connection Script file(s) compiled."

lcErrors = ""
IF !EMPTY(oScript.cCompileErrors)
   File2Var(lcPath + "WCS_Script.err",oScript.cCompileErrors)
   IF !llSilent
      MODI COMM (lcPath + "WCS_Script.err")
   ENDIF
   lcErrors = File2Var(lcPath + "WCS_Script.err")
ENDIF

RETURN lcErrors
* EOF WCSCompile
#ENDIF




* Pass lnX/YFactor by reference
FUNCTION TwipsFactor(lnXFactor, lnYFactor)
LOCAL ln_x_pixels, ln_y_pixels, ln_twips, ln_partial_x, ln_partial_y, ;
     ln_hwnd, ln_hdc

*** Calculate the factor to be used in the HitTest method...
ln_x_pixels = 88
ln_y_pixels = 90
ln_twips    = 1440

DECLARE INTEGER GetActiveWindow IN win32api
DECLARE INTEGER GetActiveWindow IN win32api
DECLARE INTEGER GetDC           IN win32api INTEGER iHDC
DECLARE INTEGER GetDeviceCaps   IN win32api INTEGER iHDC, INTEGER iIndex

ln_hwnd = GetActiveWindow()
ln_hdc  = GetDC(ln_hwnd)

ln_partial_x = GetDeviceCaps(ln_hdc, ln_x_pixels)
ln_partial_y = GetDeviceCaps(ln_hdc, ln_x_pixels)

lnXFactor = ln_twips/ln_partial_x
lnYFactor = ln_twips/ln_partial_y
RETURN


************************************************************************
FUNCTION InputForm
******************
***  Function: Creates a simple Input form that returns a value
***    Assume: Consists of this function and Form Class
***      Pass: lcValue   -   Initial value to retrieve
***            lcMessage -   The request message
***            lcCaption -   Form Caption (_Screen.Caption)
***            lnFormWidth   Width of the form
***            lnFieldWidth  Widht of the input field
***            lcFormat		  Format string for the input field
***            lcCancelValue Value returned on a Cancel operation 
***    Return: Value or ("" or -1)
************************************************************************
LPARAMETER lcValue, lcMessage, lcCaption, lnFormWidth, lnFieldWidth, lcFormat,lcCancelValue
PRIVATE pcResult
LOCAL o

IF PCOUNT() > 6
  pcCancelValue = lcCancelValue
ELSE
  pcCancelValue = NULL
ENDIF

lcValue=IIF(EMPTY(lcValue),"",lcValue)
lcMessage=IIF(EMPTY(lcMessage),"Please enter",lcMessage)
lcCaption=IIF(EMPTY(lcCaption),_SCREEN.Caption,lcCaption)
lnFormWidth=IIF(EMPTY(lnFormWidth),300,lnFormWidth)
lnFieldWidth=IIF(EMPTY(lnFieldWidth),lnFormWidth - 20,lnFieldWidth)
lcFormat=IIF(EMPTY(lcFormat),"@K",lcFormat)


lcType = VARTYPE(lcCancelValue)
pcResult = lcValue

o=CREATE("frmInput")
o.Width = lnFormWidth
o.nFieldWidth = lnFieldWidth
o.Caption = lcCaption
o.cMessage = lcMessage
o.cFormat = lcFormat

IF lcFormat = "PASSWORD"
   o.cFormat = "@K"
   o.txtInput.PasswordChar = "*"
ENDIF


o.Show()

IF TYPE("pcResult")="C"
   lcValue = TRIM(pcResult)
ELSE
   lcValue = pcResult
ENDIF   
RETURN lcValue


**************************************************
*-- Form:         frminput 
*-- ParentClass:  form
*-- BaseClass:    form
DEFINE CLASS frminput AS form
    nFieldWidth = 250
    cMessage = "Please enter:"
    cFormat = ""

	Top = 0
	Left = 0
	Height = 90
	Width = 300
	ControlBox = .F.
	Name = "frmInput"
	WindowType = 1
	AutoCenter = .t.
	Showwindow = 1
	BorderStyle = 2
	MinButton = .f.
	ShowWindow = 1
	MaxButton = .f.

	ADD OBJECT lblMessage AS label WITH ;
		AutoSize = .T., ;
		Caption = "Message Text:", ;
		Height = 17, ;
		Left = 7, ;
		Top = 11, ;
		Width = 81, ;
		Name = "lblMessage",;
		Font = "Tahoma" ,;
		FontSize = 8
		
	ADD OBJECT txtinput AS textbox WITH ;
		ControlSource = "pcResult", ;
		Height = 22, ;
		Left = 5, ;
		Top = 28, ;
		Width = 373, ;
		Name = "txtInput",;
		Font = "Tahoma" ,;
        Default = .T.,;
		FontSize = 8
	ADD OBJECT cmdOk AS commandbutton WITH ;
		Top = 55, ;
		Left = THISFORM.width - 150, ;
		Height = 25, ;
		Width = 70, ;
		Caption = "OK", ;
		Default = .T., ;
		Fontname="Tahoma",;
		Fontsize = 8,;
        Cancel = .F.,;
		Name = "cmdOK"

	ADD OBJECT cmdCancel AS commandbutton WITH ;
		Top = 55, ;
		Left = THISFORM.Width - 75, ;
		Height = 25, ;
		Width = 70, ;
		Caption = "\<Cancel", ;
		Fontname="Tahoma",;
		Fontsize = 8,;
		Cancel = .T.,;
		Name = "cmdCancel" 

    PROCEDURE Show
        THIS.Icon = _Screen.icon
        THIS.txtInput.Width = THIS.nFieldWidth
        THIS.lblMessage.Caption = THIS.cMessage
		THIS.cmdCancel.Left = THISFORM.Width - 85
		THIS.cmdOk.Left = THISFORM.Width - 157
        IF !EMPTY(THIS.cFormat)
           IF ATC("@",THIS.cFormat) > 0
             THIS.txtInput.Format = THIS.cFormat
           ELSE
             THIS.txtInput.InputMask = THIS.cFormat
           ENDIF
        ENDIF
    ENDPROC
	PROCEDURE cmdOk.Click
		RELEASE THISFORM
	ENDPROC
	PROCEDURE cmdCancel.Click
	    LOCAL lcType
       
       IF ISNULL(pcCancelValue)
   	    lcType = TYPE("pcResult")
          DO CASE
               CASE lcType $ "CM"
       	 	    pcResult = ""
        	    CASE lcType $ "NIBY"
            	    pcResult = -99999999
            	CASE lcType $ "DT"
            	    pcResult = {}
            	CASE lcType = "L"
            	    pcResult = .f.
           ENDCASE
      ELSE
         pcResult = pcCancelValue
      ENDIF
	   RELEASE THISFORM
	ENDPROC
ENDDEFINE
*
*-- EndDefine: frminput
**************************************************


**************************************************
FUNCTION IsCOMObject
*********************
*** Function: Checks to see if a COM object 
***           or ActiveX control exists
***   Assume: Uses wwAPI
***     Pass: lcProgId   - Prog Id of the Class
***           lcClassId  - (Optional) If passed in 
***                        by reference gets ClassId
***           lcClassDescript - (Optional) by ref
***   Return: .T. or .F.
*****************************************************
LPARAMETER lcProgId,lcClassId, lcClassDescript

IF EMPTY(lcProgId)
   RETURN .F.
ENDIF

loAPI = CREATE("wwAPI")

*** Retrieve ClassId and Server Name
lcClassId =  ;
   loAPI.ReadRegistryString(HKEY_CLASSES_ROOT,;
                            lcProgId + "\CLSID",;
                            "")
IF ISNULL(lcClassId)
   lcClassId = ""
   lcClassDescription = ""
   RETURN .F.
ENDIF                                       
                            
lcClassDescript = ;
   loAPI.ReadRegistryString(HKEY_CLASSES_ROOT,;
                            lcProgId,"")

IF ISNULL(lcClassDescript)
   lcClassDescript = ""
ENDIF
                                    
RETURN .T.
*
FUNCTION CopyObject
	LPARAMETERS loinput
	LOCAL loobject, lafields[1], lnx, lcfield, lctype, llclass, lncount, z, lnlength
	IF TYPE("loInput.Class") = "C"
		loobject = CREATEOBJECT(loinput.CLASS)
	ELSE
		loobject = CREATEOBJECT("EMPTY")
	ENDIF
	lncount = AMEMBERS(lafields, loinput)
	FOR lnx = 1 TO lncount
		lcfield = LOWER(lafields(lnx))
		IF AT("," + lcfield + ",", "'" + ",activecontrol,classlibrary,baseclass,comment,controls,objects,controlcount," + "class,name,parent,parentalias,parentclass,helpcontextid,whatsthishelpid," + "width,height,top,left,tag,picture,onetomany,childalias,childorder,relationalexpr,timestamp_column,") > 0
			LOOP
		ENDIF
		lctype = TYPE("loInput." + lcfield)
		DO CASE
			CASE TYPE('ALEN(loInput.' + lcfield + ')') = "N"
				IF TYPE("loObject." + lcfield) = "U"
					*!_err=0x1A0A_!(loobject, lcfield + "[1]")
				ENDIF
				lnlength = ALEN(loinput.&lcfield)
				DIMENSION loobject.&lcfield[lnLength]
				FOR z = 1 TO lnlength
					IF TYPE("loInput." + lcfield + "[z]") = "O"
						loobject.&lcfield[z] =  CopyObject(EVAL( "loInput." +  lcfield + "[z]"))
					ELSE
						loobject.&lcfield[z] = EVAL("loInput." +  lcfield)
					ENDIF
				ENDFOR
			CASE lctype = "O"
				IF TYPE("loObject." + lcfield) = "U"
					*!_err=0x1A0A_!(loobject, lcfield)
				ENDIF
				loobject.&lcfield =  CopyObject(EVAL("loInput."+lcfield))
			OTHERWISE
				IF TYPE("loObject." + lcfield) = "U"
					*!_err=0x1A0A_!(loobject, lcfield)
				ENDIF
				loobject.&lcfield = EVAL("loInput." + lcfield)
		ENDCASE
	ENDFOR
	RETURN loobject
ENDFUNC
*
PROCEDURE CopyObjectProperties
	LPARAMETERS loinput, loobject, lnobjectstructureobject
	IF (EMPTY(lnobjectstructureobject))
		lnobjectstructureobject = 1
	ENDIF
	IF lnobjectstructureobject = 1
		lncount = AMEMBERS(lafields, loinput)
	ELSE
		lncount = AMEMBERS(lafields, loobject)
	ENDIF
	FOR lnx = 1 TO lncount
		lcfield = LOWER(lafields(lnx))
		IF AT("," + lcfield + ",", "'" + ",activecontrol,classlibrary,baseclass,comment,controls,objects,controlcount," + "class,name,parent,parentalias,parentclass,helpcontextid,whatsthishelpid," + "width,height,top,left,tag,picture,onetomany,childalias,childorder,relationalexpr,timestamp_column,") > 0
			LOOP
		ENDIF
		lctype = TYPE("loInput." + lcfield)
		IF lctype = "O" .OR. lctype = "U" .OR. TYPE('ALEN(loInput.' + lcfield + ')') = "N"
			LOOP
		ENDIF
		IF lnobjectstructureobject = 1
			IF TYPE("loObject." + lcfield) = "U"
				LOOP
			ENDIF
		ELSE
			IF TYPE("loInput." + lcfield) = "U"
				LOOP
			ENDIF
		ENDIF
		*_**BA=?? 730
		loobject.&lcfield = EVAL("loInput." + lcfield)
		*!_err=0xBB_! 738
		*!_err=0xBE_!
		DO CASE
			CASE TYPE('ALEN(loInput.' + lcfield + ')') = "N"
			CASE lctype = "O"
			OTHERWISE
		ENDCASE
	ENDFOR
ENDPROC

FUNCTION CacheFile
 LPARAMETER lcFilename, lnRefreshseconds
 LOCAL lcOutput, lnHandle
 lcAlias = ALIAS()
 IF USED("wwFileCache")
      SELECT wwFilecache
 ELSE
      CREATE CURSOR wwFileCache (fiLename C (120), tiMeread T, coNtent M)
 ENDIF
 LOCATE FOR fiLename=LOWER(lcFilename)
 IF FOUND()
      IF lnRefreshseconds>0 .AND. wwFilecache.tiMeread<DATETIME()- ;
         lnRefreshseconds
           REPLACE coNtent WITH fiLe2var(lcFilename), tiMeread WITH DATETIME()
      ENDIF
      lcOutput = coNtent
 ELSE
      lcOutput = fiLe2var(lcFilename)
      INSERT INTO wwFileCache (fiLename, tiMeread, coNtent) VALUES  ;
             (LOWER(lcFilename), DATETIME(), lcOutput)
 ENDIF
 IF  .NOT. EMPTY(lcAlias)
      SELECT (lcAlias)
 ENDIF
 RETURN lcOutput
ENDFUNC
*
PROCEDURE WrCursor
 PARAMETER pcNewname
 PRIVATE lcOldalias
 lcOldalias = ALIAS()
 SELECT (lcOldalias)
 lcDbf = DBF(lcOldalias)
 IF USED(pcNewname)
      USE IN (pcNewname)
 ENDIF
 USE (lcDbf) AGAIN ALIAS (pcNewname) IN 0
 USE IN (lcOldalias)
 SELECT (pcNewname)
 RETURN
ENDPROC

FUNCTION CursorToObjectArray
 LPARAMETER lcObjname
 LOCAL lnX, laLitems[1]
 IF  .NOT. EMPTY(lcObjname)
      loResult = CREATEOBJECT("lcObjName")
 ELSE
      loResult = CREATEOBJECT("RELATION")
      loResult.adDproperty("nCount")
      loResult.adDproperty("aRows(1)",1)
 ENDIF
 lnX = 0
 SCAN
      lnX = lnX+1
      DIMENSION loResult.arOws[lnX]
      SCATTER MEMO NAME loResult.arOws[lnX]
 ENDSCAN
 loResult.ncOunt = lnX
 RETURN loResult
ENDFUNC
*
FUNCTION RegisterOleServer
 LPARAMETER lcServerpath, llUnregister, llSilent
 LOCAL llRetval, lcPath, lcOldpath
 IF  .NOT. FILE(lcServerpath)
      RETURN .F.
 ENDIF
 llRetval = .F.
 IF  .NOT. llUnregister
      lcOldpath = SYS(5)+CURDIR()
      lcPath = JUSTPATH(lcServerpath)
      CD (lcPath)
      DECLARE INTEGER DllRegisterServer IN (lcServerpath)
      IF dlLregisterserver()=0
           IF  .NOT. llSilent
                WAIT WINDOW NOWAIT lcServerpath+" has been registered..."
           ENDIF
           llRetval = .T.
      ELSE
           WAIT WINDOW TIMEOUT 5 lcServerpath+" could not be registered..."
      ENDIF
      CD (lcOldpath)
 ELSE
      DECLARE INTEGER DllUnregisterServer IN (lcServerpath)
      IF dlLunregisterserver()=0
           IF  .NOT. llSilent
                WAIT WINDOW NOWAIT lcServerpath+" has been unregistered..."
           ENDIF
           llRetval = .T.
      ENDIF
 ENDIF
 RETURN llRetval
ENDFUNC
*
FUNCTION DCOMCnfgServer
 LPARAMETER lcProgid, lcRunas, lcPassword
 LOCAL lcProgid, loApi, lcClassid, lcServername
 lcRunas = IIF(TYPE("lcRunAs")="C", lcRunas, "Interactive User")
 lcProgid = IIF(TYPE("lcProgId")="C", lcProgid, "")
 lcPassword = IIF(EMPTY(lcPassword), "", lcPassword)
 loApi = CREATEOBJECT("wwAPI")
 lcClassid = loApi.reAdregistrystring(-2147483648,lcProgid+"\CLSID","")
 lcServername = loApi.reAdregistrystring(-2147483648,lcProgid+"","")
 IF ISNULL(lcClassid) .OR. ISNULL(lcServername)
      WAIT WINDOW NOWAIT "Invalid Class Id..."
      RETURN
 ENDIF
 WAIT WINDOW NOWAIT "Configuring server security for "+CHR(13)+CHR(10)+ ;
      lcProgid+CHR(13)+CHR(10)+lcServername
 IF  .NOT. EMPTY(lcPassword)
      IF  .NOT. FILE("dcompermissions.exe")
           WAIT WINDOW TIMEOUT 5 "Couldn't find dcompermissions.exe..."
           RETURN
      ENDIF
      lcPath = FULLPATH("dcompermissions.exe")
      lcPath = shOrtpath(lcPath)
      lcCmd = "RUN "+lcPath+" -runas "+lcClassid+" "+lcRunas+" "+ ;
              lcPassword+" > dcom.txt"
      &lcCMD
      lcResult = FILETOSTR("DCOM.TXT")
      ERASE DCOM.TXT
      IF  .NOT. EMPTY(lcResult) .AND. ATC("ERROR:", lcResult)>0
           MESSAGEBOX(lcProgid+CHR(13)+"Account: "+lcUsername+CHR(13)+ ;
                     CHR(13)+lcResult, 48, "DCOM Permissions")
           RETURN .F.
      ENDIF
 ELSE
      IF  .NOT. loApi.wrIteregistrystring(-2147483646, ;
          "SOFTWARE\Classes\CLSID\"+lcClassid,"AppId",lcClassid,.T.)
           WAIT WINDOW NOWAIT "Unable to write AppID value..."
           RETURN
      ENDIF
      IF  .NOT. loApi.wrIteregistrystring(-2147483648,"AppID\"+lcClassid, ;
          CHR(0),CHR(0),.T.)
           WAIT WINDOW NOWAIT "Unable to write AppID key..."
           RETURN
      ENDIF
      loApi.wrIteregistrystring(-2147483648,"AppID\"+lcClassid,"", ;
                               lcServername,.T.)
      loApi.wrIteregistrystring(-2147483648,"AppID\"+lcClassid,"RunAs", ;
                               lcRunas,.T.)
 ENDIF
 WAIT WINDOW NOWAIT "DCOM security context set to: "+lcRunas
 RETURN
ENDFUNC
*
FUNCTION DCOMLaunchPermissions
 LPARAMETER lcProgid, lcUsername, lcErrormsg
 IF  .NOT. EMPTY(lcProgid)
      lcClassid = ""
      llResult = isComobject(lcProgid,@lcClassid)
      IF EMPTY(lcClassid)
           WAIT WINDOW "Invalid Prog ID"
           RETURN .F.
      ENDIF
 ELSE
      lcClassid = ""
 ENDIF
 lcPath = FULLPATH("dcompermissions.exe")
 lcPath = shOrtpath(lcPath)
 IF EMPTY(lcClassid)
      lcCmd = "RUN "+lcPath+" -da "+lcClassid+" set "+lcUsername+ ;
              " permit > dcom.txt"
      _CLIPTEXT = lcCmd
 ELSE
      lcCmd = "RUN "+lcPath+" -aa "+lcClassid+" set "+lcUsername+ ;
              " permit > dcom.txt"
      _CLIPTEXT = lcCmd
 ENDIF
 &lcCMD
 lcResult = FILETOSTR("DCOM.TXT")
 ERASE DCOM.TXT
 IF  .NOT. EMPTY(lcResult) .AND. ATC("ERROR:", lcResult)>0
      MESSAGEBOX(lcProgid+CHR(13)+"Account: "+lcUsername+CHR(13)+CHR(13)+ ;
                lcResult, 48, "DCOM Permissions")
      RETURN .F.
 ENDIF
 IF EMPTY(lcClassid)
      lcCmd = "RUN "+lcPath+" -dl "+lcClassid+" set "+lcUsername+ ;
              " permit > dcom.txt"
      _CLIPTEXT = lcCmd
 ELSE
      lcCmd = "RUN "+lcPath+" -al "+lcClassid+" set "+lcUsername+ ;
              " permit > dcom.txt"
      _CLIPTEXT = lcCmd
 ENDIF
 &lcCMD
 lcResult = FILETOSTR("DCOM.TXT")
 ERASE DCOM.TXT
 IF  .NOT. EMPTY(lcResult) .AND. ATC("ERROR:", lcResult)>0
      MESSAGEBOX(lcProgid+CHR(13)+"Account: "+lcUsername+CHR(13)+CHR(13)+ ;
                lcResult, 48, "DCOM Permissions")
      RETURN .F.
 ENDIF
 RETURN
ENDFUNC
*
FUNCTION FixPreTags
 LPARAMETER lcHtml, lnColwidth
 LOCAL lcPre, lcFixed, lcPrecount, lnAt1, lnAt2
 lnPrecount = 1
 DO WHILE .T.
      lnAt1 = ATC("<pre", lcHtml, lnPrecount)
      lnAt2 = ATC("/pre>", lcHtml, lnPrecount)
      IF lnAt1=0 .OR. lnAt2=0
           EXIT
      ENDIF
      lcPre = SUBSTR(lcHtml, lnAt1, lnAt2-lnAt1)
      lcFixed = STRTRAN(lcPre, "<p>", CHR(13)+CHR(10)+CHR(13)+CHR(10))
      lcFixed = STRTRAN(lcFixed, "<br>", CHR(13)+CHR(10))
      lcHtml = STRTRAN(lcHtml, lcPre, lcFixed)
      lnPrecount = lnPrecount+1
 ENDDO
 RETURN lcHtml
ENDFUNC
*
FUNCTION FixHTMLForDisplay
 LPARAMETER lcHtml
 lcHTML = STRTRAN(lcHTML,"<","&lt;")
 lcHTML = STRTRAN(lcHTML,">","&gt;")
 lcHTML = STRTRAN(lcHTML,["],"&quot;")
 RETURN lcHtml
ENDFUNC
*
FUNCTION DisplayMemo
 LPARAMETER lcHtml
 lcHtml = STRTRAN(lcHtml, CHR(13)+CHR(10), CHR(13))
 lcHtml = STRTRAN(lcHtml, CHR(10), CHR(13))
 lcHtml = STRTRAN(lcHtml, CHR(13)+CHR(13), "<p>")
 RETURN STRTRAN(lcHtml, CHR(13), "<br>")
ENDFUNC
*
FUNCTION GetSystemPassword
 LPARAMETER llUsername
 loApi = NEWOBJECT("wwAPI", "wwapi.prg")
 IF  .NOT. llUsername
      lcPass = loApi.reAdregistrystring("HKLM", ;
               "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", ;
               "DefaultPassword")
 ELSE
      lcPass = loApi.reAdregistrystring("HKLM", ;
               "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", ;
               "DefaultUserName")
 ENDIF
 IF ISNULL(lcPass)
      RETURN ""
 ENDIF
 RETURN lcPass
ENDFUNC
*
FUNCTION GetPassword
 LPARAMETER lcMessage
 IF EMPTY(lcMessage)
      lcMessage = "Please enter your password"
 ENDIF
 RETURN inPutform(SPACE(20),lcMessage,"Password Entry", , ,"PASSWORD")
ENDFUNC
*
FUNCTION IsDotNet
 LPARAMETER lcFrameworkpath, lcVersion
 LOCAL loApi, as, wwApi
 lcVersion = ""
 lcFrameworkpath = ""
 loApi = CREATEOBJECT("wwAPI")
 lcWindir = loApi.geTsystemdir(.T.)
 lcVersion = loApi.reAdregistrystring(-2147483646, ;
             "Software\Microsoft\ASP.Net","RootVer")
 IF ISNULL(lcFrameworkpath)
      RETURN .F.
 ENDIF
 lcFrameworkpath = ADDBS(loApi.reAdregistrystring(-2147483646, ;
                   "Software\Microsoft\ASP.Net\"+lcVersion,"Path"))
 RETURN .T.
ENDFUNC
*
FUNCTION MergeText
 LPARAMETER tcString, tcDelimiter, tcDelimiter2, llNoaspsyntax
 LOCAL __Loeval
 __Loeval = CREATEOBJECT('wwEval')
 RETURN __Loeval.meRgetext(@tcString,tcDelimiter,tcDelimiter2,llNoaspsyntax)
ENDFUNC
*
FUNCTION MimeDateTime
 LPARAMETER lvDatetime
 LOCAL lcDays, lcMonths, lnCount, lcMonth, ltTime, lnOffset, lnOff, lnDiff
 lcMonths = "JanFebMarAprMayJunJulAugSepOctNovDec"
 IF VARTYPE(lvDatetime)="C"
      DIMENSION laParts[1]
      lnCount = apArsestring(@laParts,lvDatetime," ")
      IF lnCount<5
           RETURN {}
      ENDIF
      lcMonth = TRANSFORM((ATC(laParts(3), lcMonths)+2)/3)
      ltTime = CTOT(lcMonth+"/"+laParts(2)+"/"+laParts(4)+" "+laParts(5))
      IF lnCount<6
           RETURN ltTime
      ENDIF
      lnOffset = geTtimezone()/60
      lnOff = VAL(laParts(6))/100
      lnDiff = (lnOffset+lnOff)*3600
      RETURN ltTime-lnDiff
 ELSE
      IF EMPTY(lvDatetime)
           lvDatetime = DATETIME()
      ENDIF
      lnDay = DOW(lvDatetime)
      IF lnDay=0
           RETURN ""
      ENDIF
      lcDays = "SunMonTueWedThuFriSat"
      lcMime = SUBSTR(lcDays, ((lnDay-1)*3)+1, 3)+", "+ ;
               TRANSFORM(DAY(lvDatetime))+" "
      lcMime = lcMime+SUBSTR(lcMonths, ((MONTH(lvDatetime)-1)*3)+1, 3)+ ;
               " "+TRANSFORM(YEAR(lvDatetime))+" "+PADL(HOUR(lvDatetime),  ;
               2, "0")+":"+PADL(MINUTE(lvDatetime), 2, "0")+":"+ ;
               PADL(SEC(lvDatetime), 2, "0")
      lnOffset = geTtimezone()/60
      RETURN lcMime+IIF(lnOffset>0, " -", " +")+ ;
             PADL(TRANSFORM(ABS(lnOffset)), 2, "0")+"00"
 ENDIF
ENDFUNC
*
FUNCTION PropertyDump
 LPARAMETER loObject
 LOCAL lnX, lnCount, lcOutput
 lnCount = AMEMBERS(laFields, loObject)
 lcOutput = ""
 FOR lnX = 1 TO lnCount
      lcType = TYPE("loObject."+laFields(lnX))
      IF ATC(lcType, "UO")=0
           lvValue = EVALUATE("loObject."+laFields(lnX))
           IF lcType="C" .AND. LEN(lvValue)>80
                lvValue = LEFT(lvValue, 80)
           ENDIF
           lcOutput = lcOutput+CHR(13)+CHR(10)+LOWER(laFields(lnX))+" = "+ ;
                      ALLTRIM(TRANSFORM(lvValue, ""))
      ELSE
           lcOutput = lcOutput+CHR(13)+CHR(10)+LOWER(laFields(lnX))+" = "+ ;
                      IIF(TYPE("loObject."+laFields(lnX))="O", "Object",  ;
                      "NULL")
      ENDIF
 ENDFOR
 RETURN lcOutput
ENDFUNC
*

FUNCTION GetMimeType
	LPARAMETERS tcExtension
	
	LOCAL lcExtension
	lcExtension = IIF(TYPE('tcExtension') = 'C', LOWER(m.tcExtension), 'txt')
	lcType = "text/plain"
	
	DO CASE 
		CASE m.lcExtension = "txt"
			lcType = "text/plain"
		CASE m.lcExtension = "pdf"
			lcType = "application/pdf"
		CASE INLIST(m.lcExtension, "png", "jpg", "jpeg", "bmp")
			lcType = "image/" + m.lcExtension
	ENDCASE 																													
	RETURN m.lcType
ENDFUNC 
