romfast/vfp_roaauto
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
vfp_roaauto/COMUN/utile/web/wwapi.PRG

1046 lines
31 KiB
Plaintext
Raw Permalink Blame History

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