Gupta.narod.ru - примеры программирования на Gupta Team Developer 2005 (GTD, CTD, TOM, Quest, SQLTalk, Report Builder, SQLWindows, SQLBase, Oracle, Web Developer, Team Object Manager)
Return to http://gupta.narod.ru/
.head 0 + Application Description:
ScriptExecute (version 1.02)
----------------------------------------
Original function 'SalExecScript' from SALextension.apl
Author ???
----------------------------------------
Updated by Andrew, 31/07/2002
http://gupta.narod.ru/ctd
----------------------------------------
Description in functional class fcExecScript
.head 1 - Outline Version - 4.0.34
.head 1 + Design-time Settings
.data VIEWINFO
0000: 6F00000001000000 FFFF01000D004347 5458566965775374 6174650400010000
0020: 00000000000D0100 002C000000020000 0003000000FFFFFF FFFFFFFFFFFCFFFF
0040: FFE9FFFFFFFFFFFF FF000000007C0200 004D010000010000 0000000000010000
0060: 000F4170706C6963 6174696F6E497465 6D0400000007436C 61737365730B6345
0080: 7865635363726970 740946756E637469 6F6E731145786563 5363726970744465
00A0: 636C617265
.enddata
.head 2 - Outline Window State: Normal
.head 2 + Outline Window Location and Size
.data VIEWINFO
0000: 6600040003002D00 0000000000000000 0000B71E5D0E0500 1D00FFFF4D61696E
0020: 0000000000000000 0000000000000000 0000003B00010000 00000000000000E9
0040: 1E800A00008600FF FF496E7465726E61 6C2046756E637469 6F6E730000000000
0060: 0000000000000000 0000000000003200 0100000000000000 0000E91E800A0000
0080: DF00FFFF56617269 61626C6573000000 0000000000000000 0000000000000000
00A0: 3000010000000000 00000000F51E100D 0000F400FFFF436C 6173736573000000
00C0: 0000000000000000 0000000000000000
.enddata
.data VIEWSIZE
0000: D000
.enddata
.head 3 - Left: -0.013"
.head 3 - Top: 0.0"
.head 3 - Width: 8.013"
.head 3 - Height: 4.969"
.head 2 + Options Box Location
.data VIEWINFO
0000: D4180909B80B1A00
.enddata
.data VIEWSIZE
0000: 0800
.enddata
.head 3 - Visible? Yes
.head 3 - Left: 4.15"
.head 3 - Top: 1.885"
.head 3 - Width: 3.8"
.head 3 - Height: 2.073"
.head 2 + Class Editor Location
.head 3 - Visible? No
.head 3 - Left: 0.575"
.head 3 - Top: 0.094"
.head 3 - Width: 5.063"
.head 3 - Height: 2.719"
.head 2 + Tool Palette Location
.head 3 - Visible? No
.head 3 - Left: 6.388"
.head 3 - Top: 0.729"
.head 2 - Fully Qualified External References? Yes
.head 2 - Reject Multiple Window Instances? No
.head 2 - Enable Runtime Checks Of External References? Yes
.head 2 - Use Release 4.0 Scope Rules? No
.head 2 - Edit Fields Read Only On Disable? No
.head 1 + Libraries
.head 2 - ! File Include: vtstr.apl
.head 2 - ! File Include: vtarray.apl
.head 1 + Global Declarations
.head 2 + Window Defaults
.head 3 + Tool Bar
.head 4 - Display Style? Etched
.head 4 - Font Name: MS Sans Serif
.head 4 - Font Size: 8
.head 4 - Font Enhancement: System Default
.head 4 - Text Color: System Default
.head 4 - Background Color: System Default
.head 3 + Form Window
.head 4 - Display Style? Etched
.head 4 - Font Name: MS Sans Serif
.head 4 - Font Size: 8
.head 4 - Font Enhancement: System Default
.head 4 - Text Color: System Default
.head 4 - Background Color: System Default
.head 3 + Dialog Box
.head 4 - Display Style? Etched
.head 4 - Font Name: MS Sans Serif
.head 4 - Font Size: 8
.head 4 - Font Enhancement: System Default
.head 4 - Text Color: System Default
.head 4 - Background Color: System Default
.head 3 + Top Level Table Window
.head 4 - Font Name: MS Sans Serif
.head 4 - Font Size: 8
.head 4 - Font Enhancement: System Default
.head 4 - Text Color: System Default
.head 4 - Background Color: System Default
.head 3 + Data Field
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + Multiline Field
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + Spin Field
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + Background Text
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + Pushbutton
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 3 + Radio Button
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + Check Box
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + Option Button
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 3 + Group Box
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + Child Table Window
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + List Box
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + Combo Box
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + Line
.head 4 - Line Color: Use Parent
.head 3 + Frame
.head 4 - Border Color: Use Parent
.head 4 - Background Color: 3D Face Color
.head 3 + Picture
.head 4 - Border Color: Use Parent
.head 4 - Background Color: Use Parent
.head 2 + Formats
.head 3 - Number: 0'%'
.head 3 - Number: #0
.head 3 - Number: ###000
.head 3 - Number: ###000;'($'###000')'
.head 3 - Date/Time: hh:mm:ss AMPM
.head 3 - Date/Time: M/d/yy
.head 3 - Date/Time: MM-dd-yy
.head 3 - Date/Time: dd-MMM-yyyy
.head 3 - Date/Time: MMM d, yyyy
.head 3 - Date/Time: MMM d, yyyy hh:mm AMPM
.head 3 - Date/Time: MMMM d, yyyy hh:mm AMPM
.head 2 - External Functions
.head 2 + Constants
.data CCDATA
0000: 3000000000000000 0000000000000000 00000000
.enddata
.data CCSIZE
0000: 1400
.enddata
.head 3 - System
.head 3 + User
.head 4 - !
.head 4 - ! String: CRLF = '
'
.head 4 - Number: DT_WindowHandle = 0
.head 4 - Number: DT_FileHandle = 4
.head 4 - Number: DT_SqlHandle = 6
.head 4 - Number: DT_SessionHandle = 8
.head 4 - !
.head 4 - Number: TL_IF = 1
.head 4 - Number: TL_LOOP = 2
.head 4 - Number: TL_WHILE = 3
.head 4 - Number: TL_SELECT = 4
.head 4 - Number: TL_CASE = 5
.head 3 - Enumerations
.head 2 - Resources
.head 2 + Variables
.head 3 - Boolean: abTempVar[*]
.head 3 - Date/Time: adtTempVar[*]
.head 3 - File Handle: afTempVar[*]
.head 3 - Long String: alsTempVar[*]
.head 3 - Number: anTempVar[*]
.head 3 - Session Handle: aSesTempVar[*]
.head 3 - Sql Handle: aSqlTempVar[*]
.head 3 - String: asTempVar[*]
.head 3 - Window Handle: ahWndTempVar[*]
.head 3 - !
.head 3 - Boolean: abTempVarArr[*, 999 ]
.head 3 - Date/Time: adtTempVarArr[*, 999 ]
.head 3 - File Handle: afTempVarArr[*, 99 ]
.head 3 - Long String: alsTempVarArr[*, 999 ]
.head 3 - Number: anTempVarArr[*, 999 ]
.head 3 - Session Handle: aSesTempVarArr[*, 999 ]
.head 3 - Sql Handle: aSqlTempVarArr[*, 99 ]
.head 3 - String: asTempVarArr[*, 999 ]
.head 3 - Window Handle: ahWndTempVarArr[*, 99 ]
.head 3 - ! -------------------------------------------------------
.head 2 + Internal Functions
.head 3 + Function: SalExecScript
.head 4 - Description:
ScriptExecute (version 1.02)
----------------------------------------
Original function 'SalExecScript' from SALextension.apl
Author ???
----------------------------------------
Updated by Andrew, 31/07/2002
http://gupta.narod.ru/ctd
----------------------------------------
Description in functional class fcExecScript
.head 4 + Returns
.head 5 - Boolean:
.head 4 + Parameters
.head 5 - String: fpsFileName
.head 5 - String: strContext
.head 4 - Static Variables
.head 4 + Local variables
.head 5 - FunctionalVar: objExecScript
.head 6 - Class: cExecScript
.head 4 + Actions
.head 5 - Return objExecScript.ExecScript ( fpsFileName, strContext )
.head 3 + Function: SetNumber
.head 4 - Description:
.head 4 - Returns
.head 4 + Parameters
.head 5 - Receive Number: p
.head 5 - Number: p1
.head 4 - Static Variables
.head 4 - Local variables
.head 4 + Actions
.head 5 - Set p = p1
.head 3 + Function: SetString
.head 4 - Description:
.head 4 - Returns
.head 4 + Parameters
.head 5 - Receive String: p
.head 5 - String: p1
.head 4 - Static Variables
.head 4 - Local variables
.head 4 + Actions
.head 5 - Set p = p1
.head 3 + Function: SetBoolean
.head 4 - Description:
.head 4 - Returns
.head 4 + Parameters
.head 5 - Receive Boolean: p
.head 5 - Boolean: p1
.head 4 - Static Variables
.head 4 - Local variables
.head 4 + Actions
.head 5 - Set p = p1
.head 3 + Function: SetDateTime
.head 4 - Description:
.head 4 - Returns
.head 4 + Parameters
.head 5 - Receive Date/Time: p
.head 5 - Date/Time: p1
.head 4 - Static Variables
.head 4 - Local variables
.head 4 + Actions
.head 5 - Set p = p1
.head 3 + Function: SetFileHandle
.head 4 - Description:
.head 4 - Returns
.head 4 + Parameters
.head 5 - Receive File Handle: p
.head 5 - File Handle: p1
.head 4 - Static Variables
.head 4 - Local variables
.head 4 + Actions
.head 5 - Set p = p1
.head 3 + Function: SetLongString
.head 4 - Description:
.head 4 - Returns
.head 4 + Parameters
.head 5 - Receive Long String: p
.head 5 - Long String: p1
.head 4 - Static Variables
.head 4 - Local variables
.head 4 + Actions
.head 5 - Set p = p1
.head 3 + Function: SetSessionHandle
.head 4 - Description:
.head 4 - Returns
.head 4 + Parameters
.head 5 - Receive Session Handle: p
.head 5 - Session Handle: p1
.head 4 - Static Variables
.head 4 - Local variables
.head 4 + Actions
.head 5 - Set p = p1
.head 3 + Function: SetSqlHandle
.head 4 - Description:
.head 4 - Returns
.head 4 + Parameters
.head 5 - Receive Sql Handle: p
.head 5 - Sql Handle: p1
.head 4 - Static Variables
.head 4 - Local variables
.head 4 + Actions
.head 5 - Set p = p1
.head 3 + Function: SetWindowHandle
.head 4 - Description:
.head 4 - Returns
.head 4 + Parameters
.head 5 - Receive Window Handle: p
.head 5 - Window Handle: p1
.head 4 - Static Variables
.head 4 - Local variables
.head 4 + Actions
.head 5 - Set p = p1
.head 2 - Named Menus
.head 2 + Class Definitions
.data RESOURCE 0 0 1 2582542047
0000: 9100000065000000 0000000000000000 0200000100FFFF01 00160000436C6173
0020: 73566172004F7574 6C696E6552006567 496E666F1E003C00 000C660063457865
0040: 6353637200697074 5A00000003780000 0002200400000001 0000FFE080010000
0060: 009F0400C000010D 000000FF7F117000 00000100FFFF01
.enddata
.head 3 + Functional Class: cExecScript
.head 4 - Description:
version 1.02
---------------------------------------------------------------------------------
Original function 'ExecScript' from SALextension.apl
Author ???
---------------------------------------------------------------------------------
Updated by Andrew, 31/07/2002
http://gupta.narod.ru/ctd
v 1.02
- New operators added
Select Case
EndSelectCase
Case
EndCase
Default
Return
Else If
- Variables declaration added (one-dimensional arrays allowed)
ATTENTION: Any variable name must be UNIQUE!
I recommend use 2-3 underline in ALL variable names
Number
Boolean
Date/Time
String
Long String
Window Handle
Sql Handle
File Handle
- New section added
Variables
Actions
- Some constants added
DT_WindowHandle
DT_FileHandle
DT_SqlHandle
- SalExecScript routine moved to functional class fcExecScript
- Changed
SalAnsiToOem
SalOemToAnsi
v 1.01
- New operators added
Loop
EndLoop
Break
Else
While
EndWhile
Call
- Extended error message
- All variables was moved to global area
- You can set execution context now
- Comment line has an exclamation mark (!) at the beginning of the line
- New format:
Boolean ExecScript ( strScriptName, sContext )
- You can inverse quiet mode:
bQuietMode = ExecScript ( '', '' )
****************************************************************************
Runs a script. (Like the expressiondialog of CTD in debugmode)
- comments start with a semicolon ';' or '!'
- no 'Call' in front of function calls (like in the expressions dialog)
- as variables for each datatype there are 3 variables and one array predefined
(see down)
- you can also use normal variables which are accessible in the context
(when not, full qualification should help)
- 'While' and 'Loop' supported until now !!!
-an 'If' construct must end with an 'Endif'
sTemp1, sTemp2, sTemp3, asTemp[*]
strTemp1, strTemp2, strTemp3, astrTemp[*]
nTemp1, nTemp2, nTemp3, anTemp[*]
intTemp1, intTemp2, intTemp3, aintTemp[*]
dTemp1, dTemp2, dTemp3, adTemp[*]
dtTemp1, dtTemp2, dtTemp3, adtTemp[*]
hWndTemp1, hWndTemp2, hWndTemp3, ahWndTemp[*]
bTemp1, bTemp2, bTemp3, abTemp[*]
SqlTemp1, SqlTemp2, SqlTemp3, aSqlTemp[*]
lsTemp1, lsTemp2, lsTemp3, alsTemp[*]
fTemp1, fTemp2, fTemp3, afTemp[*]
Example: Test.sal
Set df1 = 'Test'
if strTemp1 = df1
Set df1 = 'GehtXX !!!'
endif
;Set df2 = df3
Set df1 = df1 || ' geht doch'
Set hWndTemp1 = df2
Set strTemp1 = 'Joh'
SalSetWindowText(hWndTemp1 ,strTemp1)
SalSetFocus(df1)
Set ahWndTemp[1] = df1
SalMessageBeep(-1)
SalSetFocus(df1)
; -------------Sql-Test-----------------
SqlConnect(SqlTemp1)
SqlPrepareAndExecute(SqlTemp1,"SELECT count(*) into :strTemp1 From mis.TB_objects where rownum < 20")
SqlFetchNext(SqlTemp1,nTemp1)
SalMessageBox(strTemp1,'Test',0)
SqlDisconnect(SqlTemp1)
Call ExecScript ( 'Test.sal', SalContextCurrent() )
.head 4 - Derived From
.head 4 + Class Variables
.head 5 - String: asVarToReal[*]
.head 5 - Boolean: bInit
.head 5 - Boolean: bQuietMode
.head 4 + Instance Variables
.head 5 - String: asVariables[*]
.head 5 - String: asVariablesReal[*]
.head 5 - Number: anVariables[8]
.head 5 - Number: anArrays[8]
.head 5 - Number: nMaxVariable
.head 5 - !
.head 5 - Boolean: bLevelExecute[*]
.head 5 - Number: nLevelType[*]
.head 5 - Number: nGotoLine[*]
.head 5 - Number: nLevel
.head 5 - !
.head 5 - Long String: alsLine [ * ]
.head 5 - Long String: lsLine
.head 5 - Number: nCurLine
.head 5 - !
.head 5 - Number: nError
.head 5 - Number: nErrorPos
.head 5 - !
.head 5 - String: sFileName
.head 5 - String: sContext
.head 4 + Functions
.head 5 + Function: ExecScript
.head 6 - Description:
.head 6 + Returns
.head 7 - Boolean:
.head 6 + Parameters
.head 7 - String: sFileNamePar
.head 7 - String: sContextPar
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Boolean: lbResult
.head 7 - File Handle: lfhScript
.head 7 - Number: nMaxLine
.head 7 - Number: nLoop
.head 6 + Actions
.head 7 - Set sFileName = sFileNamePar
.head 7 - Set sContext = sContextPar
.head 7 + If NOT bInit
.head 8 - Call ExecScriptInit ( )
.head 8 - Set bInit = TRUE
.head 7 + If sFileName = ''
.head 8 - Set bQuietMode = NOT bQuietMode
.head 8 - Return bQuietMode
.head 7 + Else
.head 8 - Set lbResult = FALSE
.head 8 - Set bLevelExecute[0] = TRUE
.head 8 - Set nGotoLine[0] = -1
.head 8 - !
.head 8 + If SalFileOpen(lfhScript, sFileName, OF_Read)
.head 9 - Call SalWaitCursor( TRUE )
.head 9 - Set lbResult = TRUE
.head 9 - ! read Script
.head 9 + While SalFileGetStr(lfhScript, lsLine, 4096)
.head 10 - ! when comment, or nothing -> ignore
.head 10 + If SalStrLeftX ( SalStrTrimX ( lsLine), 1 ) != ';'
and SalStrLeftX ( SalStrTrimX ( lsLine), 1 ) != '!'
and SalStrTrimX(lsLine) != ''
.head 11 - !
.head 11 - ! security Check
.head 11 + If SalStrScan(lsLine,'SqlPassword') > -1
.head 12 - Set lsLine = VisStrSubstitute(lsLine, 'SqlPassword', '')
.head 12 + If not bQuietMode
.head 13 - Call SalMessageBox("Script '" || sFileName || "' Security Alert !",
"Warning", MB_Ok | MB_IconExclamation)
.head 11 - !
.head 11 - ! ok Execute line
.head 11 + Else
.head 12 - Set nCurLine = nMaxLine
.head 12 - Set nMaxLine = nMaxLine + 1
.head 12 - Call ExecScriptReplaceVarReal ( lsLine )
.head 12 - Set alsLine [ nMaxLine ] = lsLine
.head 12 + Loop
.head 13 - Set nCurLine = nCurLine + 1
.head 13 + If nCurLine > nMaxLine
.head 14 - Break
.head 13 - Set lsLine = VisStrTrim( alsLine [ nCurLine ] )
.head 13 + If ExecScriptMain ( )
.head 14 - Break
.head 12 - !
.head 10 + If nError != 0
.head 11 - Break
.head 9 - !
.head 9 - Call SalWaitCursor( FALSE )
.head 9 - Call SalFileClose(lfhScript)
.head 8 + Else
.head 9 + If not bQuietMode
.head 10 - Call SalMessageBox("Script '" || sFileName || "' not found !",
"Error", MB_Ok | MB_IconExclamation)
.head 8 - Return lbResult
.head 5 + Function: ExecScriptAddVar
.head 6 - Description: Add new variable
.head 6 + Returns
.head 7 - Boolean:
.head 6 + Parameters
.head 7 - Number: nType
.head 7 - String: lsLine
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Number: nPos
.head 7 - Number: nIndex
.head 6 + Actions
.head 7 - Set nIndex = ExecScriptFindVar ( lsLine )
.head 7 + If nIndex >= 0
.head 8 - Return FALSE
.head 7 + Else
.head 8 - Set nPos = SalStrScan( lsLine, '[' )
.head 8 + If nPos >= 0
.head 9 - Set lsLine = VisStrTrim( SalStrLeftX( lsLine, nPos ) )
.head 9 - Set asVariablesReal [ nMaxVariable ] = asVarToReal [ nType ] || 'Arr[' ||
SalNumberToStrX( anArrays [ nType ], 0 ) || ']'
.head 9 - Set anArrays [ nType ] = anArrays [ nType ] + 1
.head 8 + Else
.head 9 - Set anVariables [ nType ] = anVariables [ nType ] + 1
.head 9 - Set asVariablesReal [ nMaxVariable ] = asVarToReal [ nType ] || '[' ||
SalNumberToStrX( anVariables [ nType ], 0 ) || ']'
.head 8 - !
.head 8 - Set asVariables [ nMaxVariable ] = lsLine
.head 8 - Set nMaxVariable = nMaxVariable + 1
.head 8 - !
.head 8 - Return TRUE
.head 5 + Function: ExecScriptReplaceVarReal
.head 6 - Description: Add new variable
.head 6 - Returns
.head 6 + Parameters
.head 7 - Receive String: lsLine
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Number: nCurVar
.head 6 + Actions
.head 7 - ! If SalStrScan( SalStrLowerX ( lsLine ), '\_\_' ) >= 0
.head 7 - Set nCurVar = 0
.head 7 + While nCurVar < nMaxVariable
.head 8 - Set lsLine = VisStrSubstitute( lsLine, asVariables [ nCurVar ], asVariablesReal [ nCurVar ] )
.head 8 - Set nCurVar = nCurVar + 1
.head 7 - Set lsLine = VisStrSubstitute( lsLine, '][', ',' )
.head 7 - Set lsLine = VisStrSubstitute( lsLine, '] [', ',' )
.head 5 + Function: ExecScriptFindVar
.head 6 - Description:
.head 6 + Returns
.head 7 - Number:
.head 6 + Parameters
.head 7 - Receive String: lsLine
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Number: nPos
.head 6 + Actions
.head 7 - Set nPos = SalStrScan( lsLine, '!' )
.head 7 + If nPos >= 0
.head 8 - Set lsLine = VisStrTrim( SalStrLeftX( lsLine, nPos ) )
.head 7 - Return VisArrayFindString ( asVariables, lsLine)
.head 5 + Function: ExecScriptInit
.head 6 - Description:
.head 6 - Returns
.head 6 - Parameters
.head 6 - Static Variables
.head 6 - Local variables
.head 6 + Actions
.head 7 - Set asVarToReal [ DT_Boolean ] = 'abTempVar'
.head 7 - Set asVarToReal [ DT_DateTime ] = 'adtTempVar'
.head 7 - Set asVarToReal [ DT_Number ] = 'anTempVar'
.head 7 - Set asVarToReal [ DT_String ] = 'asTempVar'
.head 7 - Set asVarToReal [ DT_LongString ] = 'alsTempVar'
.head 7 - Set asVarToReal [ DT_WindowHandle ] = 'ahWndTempVar'
.head 7 - Set asVarToReal [ DT_FileHandle ] = 'afTempVar'
.head 7 - Set asVarToReal [ DT_SqlHandle ] = 'aSqlTempVar'
.head 7 - Set asVarToReal [ DT_SessionHandle ] = 'aSesTempVar'
.head 5 + Function: ExecScriptMain
.head 6 - Description:
.head 6 + Returns
.head 7 - Boolean:
.head 6 - Parameters
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Number: nType
.head 7 - Number: nReturn
.head 7 - String: strReturn
.head 7 - Date/Time: dtReturn
.head 7 - Window Handle: hWndReturn
.head 7 - String: sWord
.head 7 - Number: nLevelBreak
.head 6 + Actions
.head 7 - Set sWord = ExecScriptGetWord ( )
.head 7 + If sWord = 'if'
.head 8 - Set nLevel = nLevel + 1
.head 8 - Set nLevelType[ nLevel ] = TL_IF
.head 8 - Set bLevelExecute[ nLevel ] = FALSE
.head 8 + If bLevelExecute[ nLevel - 1]
.head 9 - Set nType = SalCompileAndEvaluate(lsLine ,nError, nErrorPos, nReturn, strReturn, dtReturn, hWndReturn, bQuietMode, sContext )
.head 9 - ! when 'if' was true
.head 9 + If nReturn = 1
.head 10 - Set bLevelExecute[ nLevel ] = TRUE
.head 7 + Else If sWord = 'else'
.head 8 + If nLevelType[ nLevel ] = TL_IF
.head 9 + If bLevelExecute [ nLevel ]
.head 10 - Set bLevelExecute [ nLevel ] = FALSE
.head 9 + Else If bLevelExecute [ nLevel - 1 ]
.head 10 - Set bLevelExecute [ nLevel ] = TRUE
.head 10 + If SalStrLowerX ( SalStrLeftX( lsLine, 7 ) ) = 'else if'
.head 11 - Set lsLine = 'if ' || SalStrRightX( lsLine, SalStrLength( lsLine ) - 7 )
.head 11 - Set nType = SalCompileAndEvaluate(lsLine ,nError, nErrorPos, nReturn, strReturn, dtReturn, hWndReturn, bQuietMode, sContext )
.head 11 - ! when 'if' was false
.head 11 + If nReturn != 1
.head 12 - Set bLevelExecute [ nLevel ] = FALSE
.head 8 + Else
.head 9 - Set nError = -TL_IF
.head 7 + Else If sWord = 'endif'
.head 8 + If nLevelType[ nLevel ] = TL_IF
.head 9 - Set nLevel = nLevel - 1
.head 8 + Else
.head 9 - Set nError = -TL_IF
.head 7 + Else If sWord = 'loop'
.head 8 - Set nLevel = nLevel + 1
.head 8 - Set nGotoLine[ nLevel ] = nCurLine
.head 8 - Set nLevelType[ nLevel ] = TL_LOOP
.head 8 - Set bLevelExecute[ nLevel ] = bLevelExecute[ nLevel - 1 ]
.head 7 + Else If sWord = 'endloop'
.head 8 + If nLevelType[ nLevel ] = TL_LOOP
.head 9 + If bLevelExecute[ nLevel ]
.head 10 - Set nCurLine = nGotoLine[ nLevel ]
.head 9 + Else
.head 10 - Set nLevel = nLevel - 1
.head 8 + Else
.head 9 - Set nError = -TL_LOOP
.head 7 + Else If sWord = 'break'
.head 8 + If bLevelExecute [ nLevel ]
.head 9 - Set nLevelBreak = nLevel
.head 9 + While nLevelBreak > 0
.head 10 + If bLevelExecute[ nLevelBreak ]
AND nLevelType[ nLevelBreak ] = TL_CASE
.head 11 - Set bLevelExecute[ nLevelBreak - 1 ] = FALSE
.head 10 - Set bLevelExecute[ nLevelBreak ] = FALSE
.head 10 + If nLevelType[ nLevelBreak ] = TL_LOOP
OR nLevelType[ nLevelBreak ] = TL_WHILE
OR nLevelType[ nLevelBreak ] = TL_CASE
.head 11 - Break
.head 10 - Set nLevelBreak = nLevelBreak - 1
.head 9 + If nLevelType[ nLevelBreak ] != TL_LOOP
AND nLevelType[ nLevelBreak ] != TL_WHILE
AND nLevelType[ nLevelBreak ] != TL_CASE
.head 10 - Set nError = -TL_LOOP
.head 7 + Else If sWord = 'return'
.head 8 - Set nLevelBreak = nLevel
.head 8 + While nLevelBreak >= 0
.head 9 - Set bLevelExecute[ nLevelBreak ] = FALSE
.head 9 - Set nLevelBreak = nLevelBreak - 1
.head 7 + Else If sWord = 'while'
.head 8 - Set nLevel = nLevel + 1
.head 8 - Set bLevelExecute[ nLevel ] = FALSE
.head 8 - Set nLevelType[ nLevel ] = TL_WHILE
.head 8 - Set nGotoLine[ nLevel ] = nCurLine - 1
.head 8 + If bLevelExecute [ nLevel - 1 ]
.head 9 - Set lsLine = 'if ' || SalStrRightX( lsLine, SalStrLength( lsLine ) - 5 )
.head 9 - Set nType = SalCompileAndEvaluate(lsLine ,nError, nErrorPos, nReturn, strReturn, dtReturn, hWndReturn, bQuietMode, sContext )
.head 9 - ! when 'while' was true
.head 9 + If nReturn = 1
.head 10 - Set bLevelExecute[ nLevel ] = TRUE
.head 7 + Else If sWord = 'endwhile'
.head 8 + If nLevelType[ nLevel ] = TL_WHILE
.head 9 + If bLevelExecute[ nLevel ]
.head 10 - Set nCurLine = nGotoLine[ nLevel ]
.head 9 - Set nLevel = nLevel - 1
.head 8 + Else
.head 9 - Set nError = -TL_WHILE
.head 7 + Else If sWord = 'select'
AND SalStrLowerX ( SalStrLeftX( lsLine, 11 ) ) = 'select case'
.head 8 - Set nLevel = nLevel + 1
.head 8 - Set bLevelExecute[ nLevel ] = FALSE
.head 8 - Set nLevelType[ nLevel ] = TL_SELECT
.head 8 - Set nGotoLine[ nLevel ] = nCurLine
.head 8 + If bLevelExecute [ nLevel - 1 ]
.head 9 - Set alsLine [ nCurLine ] = SalStrRightX( lsLine, SalStrLength( lsLine ) - 11 )
.head 9 - Set bLevelExecute[ nLevel ] = TRUE
.head 9 + !
.head 10 + Select Case nVar
.head 11 + Case 1
.head 12 - ...
.head 12 - Break
.head 11 - EndCase
.head 11 + Default
.head 12 - ...
.head 10 - EndSelectCase
.head 7 + Else If sWord = 'case'
.head 8 + If nLevelType[ nLevel ] = TL_SELECT
.head 9 - Set nLevel = nLevel + 1
.head 9 - Set bLevelExecute[ nLevel ] = FALSE
.head 9 - Set nLevelType[ nLevel ] = TL_CASE
.head 9 + If bLevelExecute [ nLevel - 1 ]
.head 10 - Set lsLine = 'if ' || alsLine [ nGotoLine[ nLevel - 1 ] ] || '=' ||
SalStrRightX( lsLine, SalStrLength( lsLine ) - 5 )
.head 10 - Set nType = SalCompileAndEvaluate(lsLine ,nError, nErrorPos, nReturn, strReturn, dtReturn, hWndReturn, bQuietMode, sContext )
.head 10 + If nReturn = 1
.head 11 - Set bLevelExecute[ nLevel ] = TRUE
.head 8 + Else
.head 9 - Set nError = -TL_SELECT
.head 7 + Else If sWord = 'endcase'
.head 8 + If nLevelType[ nLevel ] = TL_CASE
.head 9 - Set nLevel = nLevel - 1
.head 8 + Else
.head 9 - Set nError = -TL_CASE
.head 7 + Else If sWord = 'endselectcase'
.head 8 + If nLevelType[ nLevel ] = TL_SELECT
.head 9 - Set nLevel = nLevel - 1
.head 8 + Else
.head 9 - Set nError = -TL_SELECT
.head 7 + Else If sWord = 'default'
.head 8 + If nLevelType[ nLevel ] != TL_SELECT
.head 9 - Set nError = -TL_SELECT
.head 7 + Else If sWord = 'call'
.head 8 + If bLevelExecute [ nLevel ]
.head 9 - Set lsLine = VisStrTrim( SalStrRightX( lsLine, SalStrLength( lsLine ) - 5 ) )
.head 9 - Set nType = SalCompileAndEvaluate(lsLine ,nError, nErrorPos, nReturn, strReturn, dtReturn, hWndReturn, bQuietMode, sContext )
.head 9 + If nError > 0
.head 10 - Set nErrorPos = nErrorPos + 5
.head 7 + Else If sWord = 'variables'
.head 8 - !
.head 7 + Else If sWord = 'actions'
.head 8 - !
.head 7 + ! Else If sWord = 'set'
.head 8 + If bLevelExecute [ nLevel ]
.head 9 - Set nType = SalCompileAndEvaluate(lsLine ,nError, nErrorPos, nReturn, strReturn, dtReturn, hWndReturn, bQuietMode, sContext )
.head 7 + Else If bLevelExecute [ nLevel ]
.head 8 + If nLevel != 0 OR NOT ExecScriptDeclare ( )
.head 9 - Set nType = SalCompileAndEvaluate(lsLine ,nError, nErrorPos, nReturn, strReturn, dtReturn, hWndReturn, bQuietMode, sContext )
.head 7 - !
.head 7 + If nError = 0
.head 8 - Return FALSE
.head 7 + Else
.head 8 - Return ExecScriptError ( )
.head 5 + Function: ExecScriptError
.head 6 - Description:
.head 6 + Returns
.head 7 - Boolean:
.head 6 - Parameters
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - String: sCurLine
.head 7 - Number: nLen
.head 7 - String: sError
.head 6 + Actions
.head 7 - Set sCurLine = alsLine [ nCurLine ]
.head 7 + If nErrorPos > 0
.head 8 - Set nLen = SalStrLength( sCurLine )
.head 8 + If nErrorPos <= nLen
.head 9 - Set sCurLine = SalStrLeftX( sCurLine, nErrorPos ) || "***" ||
SalStrRightX( sCurLine, nLen - nErrorPos )
.head 8 + Else
.head 9 - Set sCurLine = sCurLine || "***"
.head 7 + If nError > 0
.head 8 - Set sError = "number: " || SalNumberToStrX( nError, 0 )
.head 7 + Else If nError < 0
.head 8 + Select Case -nError
.head 9 + Case TL_IF
.head 10 - Set sError = 'IF not found'
.head 10 - Break
.head 9 + Case TL_LOOP
.head 10 - Set sError = 'LOOP not found'
.head 10 - Break
.head 9 + Case TL_WHILE
.head 10 - Set sError = 'WHILE not found'
.head 10 - Break
.head 9 + Case TL_CASE
.head 10 - Set sError = 'CASE not found'
.head 10 - Break
.head 9 + Case TL_SELECT
.head 10 - Set sError = 'SELECT not found'
.head 10 - Break
.head 7 + If SalMessageBox(
"Script name: " || sFileName || '
' || "Line number: " || SalNumberToStrX( nCurLine, 0 ) || '
'
|| "Error " || sError || '
'
|| "Position: "
|| SalNumberToStrX( nErrorPos, 0 ) || ' (marked ***).
' || "String (ANSI): " || sCurLine || '
' || "String (OEM): " || SalFmtOemToAnsi ( sCurLine ) || '
' || "Continue?",
"Error",
MB_YesNo | MB_IconQuestion ) = IDNO
.head 8 - Return TRUE
.head 7 + Else
.head 8 - Return FALSE
.head 5 + Function: ExecScriptDeclare
.head 6 - Description:
.head 6 - Returns
.head 6 - Parameters
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Boolean: bDeclare
.head 7 - String: sWord
.head 6 + Actions
.head 7 - Set bDeclare = TRUE
.head 7 - Set sWord = ExecScriptGetWord ( )
.head 7 - !
.head 7 - ! 'Number' ??
.head 7 + If sWord = 'number:'
.head 8 - Set lsLine = VisStrTrim( SalStrRightX( lsLine, SalStrLength( lsLine ) - 7 ) )
.head 8 - Call ExecScriptAddVar ( DT_Number, lsLine )
.head 7 - !
.head 7 - ! 'Boolean' ??
.head 7 + Else If sWord = 'boolean:'
.head 8 - Set lsLine = VisStrTrim( SalStrRightX( lsLine, SalStrLength( lsLine ) - 8 ) )
.head 8 - Call ExecScriptAddVar ( DT_Boolean, lsLine )
.head 7 - !
.head 7 - ! 'String' ??
.head 7 + Else If sWord = 'string:'
.head 8 - Set lsLine = VisStrTrim( SalStrRightX( lsLine, SalStrLength( lsLine ) - 7 ) )
.head 8 - Call ExecScriptAddVar ( DT_String, lsLine )
.head 7 - !
.head 7 - ! 'DateTime' ??
.head 7 + Else If sWord = 'date/time:'
.head 8 - Set lsLine = VisStrTrim( SalStrRightX( lsLine, SalStrLength( lsLine ) - 10 ) )
.head 8 - Call ExecScriptAddVar ( DT_DateTime, lsLine )
.head 7 - !
.head 7 - ! 'LongString' ??
.head 7 + Else If sWord = 'longstring:'
.head 8 - Set lsLine = VisStrTrim( SalStrRightX( lsLine, SalStrLength( lsLine ) - 11 ) )
.head 8 - Call ExecScriptAddVar ( DT_LongString, lsLine )
.head 7 - !
.head 7 - ! 'WindowHandle' ??
.head 7 + Else If sWord = 'windowhandle:'
.head 8 - Set lsLine = VisStrTrim( SalStrRightX( lsLine, SalStrLength( lsLine ) - 13 ) )
.head 8 - Call ExecScriptAddVar ( DT_WindowHandle, lsLine )
.head 7 - !
.head 7 - ! 'FileHandle' ??
.head 7 + Else If sWord = 'filehandle:'
.head 8 - Set lsLine = VisStrTrim( SalStrRightX( lsLine, SalStrLength( lsLine ) - 11 ) )
.head 8 - Call ExecScriptAddVar ( DT_FileHandle, lsLine )
.head 7 - !
.head 7 - ! 'SqlHandle' ??
.head 7 + Else If sWord = 'sqlhandle:'
.head 8 - Set lsLine = VisStrTrim( SalStrRightX( lsLine, SalStrLength( lsLine ) - 11 ) )
.head 8 - Call ExecScriptAddVar ( DT_SqlHandle, lsLine )
.head 7 - !
.head 7 - ! 'SessionHandle' ??
.head 7 + Else If sWord = 'sessionhandle:'
.head 8 - Set lsLine = VisStrTrim( SalStrRightX( lsLine, SalStrLength( lsLine ) - 14 ) )
.head 8 - Call ExecScriptAddVar ( DT_SessionHandle, lsLine )
.head 7 - !
.head 7 + Else
.head 8 - Set bDeclare = FALSE
.head 7 - !
.head 7 - Return bDeclare
.head 5 + Function: ExecScriptGetWord
.head 6 - Description:
.head 6 + Returns
.head 7 - String:
.head 6 - Parameters
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - String: sLine
.head 7 - Number: nPos
.head 6 + Actions
.head 7 - Set sLine = SalStrLowerX ( lsLine )
.head 7 - Set nPos = SalStrScan( sLine, ' ' )
.head 7 + If nPos < 0
.head 8 - Set nPos = SalStrScan( sLine, ' ' )
.head 7 + If nPos < 0
.head 8 - Return sLine
.head 7 + Else
.head 8 - Return SalStrLeftX( sLine, nPos )
.head 2 + Default Classes
.head 3 - MDI Window: cBaseMDI
.head 3 - Form Window:
.head 3 - Dialog Box:
.head 3 - Table Window:
.head 3 - Quest Window:
.head 3 - Data Field:
.head 3 - Spin Field:
.head 3 - Multiline Field:
.head 3 - Pushbutton:
.head 3 - Radio Button:
.head 3 - Option Button:
.head 3 - Check Box:
.head 3 - Child Table:
.head 3 - Quest Child Window: cQuickDatabase
.head 3 - List Box:
.head 3 - Combo Box:
.head 3 - Picture:
.head 3 - Vertical Scroll Bar:
.head 3 - Horizontal Scroll Bar:
.head 3 - Column:
.head 3 - Background Text:
.head 3 - Group Box:
.head 3 - Line:
.head 3 - Frame:
.head 3 - Custom Control:
.head 3 - ActiveX:
.head 2 - Application Actions
Return to http://gupta.narod.ru/