Встроенные процедуры Clarion

Rec RECORD

Name STRING(20),NAME('Nam:Name')

Number SHORT,NAME('Nam:Number')

END

END

CODE

BUILD(Nam:DynNdx,'+Nam:Number,+Nam:Name')

BIND('Nam:Name',Nam:Name) !Связать переменную фильтра

BUILD(Nam:DynNdx,'+Nam:Name','UPPER(Nam:Name[1]) = A')

UNBIND('Nam:Name') !Освободить переменную фильтра

CODE

DosFileName STRING(260),STATIC

LastRec LONG

SavPtr LONG(1) !Начинается с 1

FileSize LONG

DosFile FILE,DRIVER('DOS'),PRE(DOS),NAME(DosFileName)

Record RECORD

F1 STRING(2000)

END

END

BlobStorage FILE,DRIVER('TopSpeed'),PRE(STO)

File BLOB,BINARY

Record RECORD

FileName STRING(64)

END

END

CODE

IF NOT FILEDIALOG('Choose File to Store',DosFileName,,0010b)

RETURN

END

OPEN(BlobStorage) !Открыть файл BLOB

STO:FileName = DosFileName !и сохранить имя файла

FileSize = BYTES(DosFile) !Получить размер файла

LastRec = FileSize % SIZE(DOS:Record) !Проверить неполную запись в конце файла

LOOP INT(FileSize/SIZE(DOS:Record)) TIMES

GET(DosFile,SavPtr) !Получить запись

ASSERT(NOT ERRORCODE())

!String slice data into BLOB:

STO:File[SavPtr - 1 : SavPtr + SIZE(DOS:Record) - 2] = DOS:Record

SavPtr += SIZE(DOS:Record) !Вычислить следующий указатель на запись

END

IF LastRec !Если в конце файла неполная запись

GET(DosFile,SavPtr) !Получить последнюю запись

STO:File[SavPtr - 1 : SavPtr + LastRec - 2] = DOS:Record

END

ADD(BlobStorage)

ASSERT(NOT ERRORCODE())

CLOSE(DosFile);CLOSE(BlobStorage)

PROGRAM

MAP

END

INCLUDE ('FILECB.INC'),ONCE

!Data file

People FILE,DRIVER('TOPSPEED'),PRE(PEO),CREATE,BINDABLE,THREAD

KeyId KEY(PEO:Id),NOCASE,OPT

KeyLastName KEY(PEO:LastName),DUP,NOCASE

Record RECORD,PRE()

Id LONG

FirstName STRING(30)

LastName STRING(30)

Gender LONG

END

END

!Log File

LogFile FILE,DRIVER('BASIC','/ALWAYSQUOTE=OFF /COMMA=1,1'),CREATE,NAME('logfile.txt')

Record RECORD

Operation STRING(200)

END

END

!FileCallBack Class

FCB CLASS,IMPLEMENTS(FileCallBackInterface)

END

CALLBACK(People, FCB.FileCallBackInterface) !Зарегистрировать интерфейс FCB

CREATE(Logfile) !Создать лог-файл

OPEN(People) !Открыть файл с данными

SET(PEO:KeyId, PEO:KeyID) !Установить указатель и

LOOP !идти по файлу

IF ERRORCODE()

BREAK !не дойдем до конца файла

END

END

CLOSE(People) !Закрыть файл с данными

!Разрегистрировать интерфейс FCB:

CALLBACK(People, FCB.FileCallBackInterface, TRUE)

!Этот метод вызывается перед каждой операцией с файлом данных.

!Лог-файл модифицируется операциями с файлом.

FCB.FileCallBackInterface.FunctionCalled |

PROCEDURE(SIGNED opCode, *Params Parameters, *CSTRING ErrCode, *CSTRING ErrMsg)

p LIKE(Params)

CODE

p = Parameters

IF p.View &= NULL !used to detect VIEW or FILE callback

f = 'FILE'

ELSE

f = 'VIEW'

END

CASE opCode

OF DriverOp:ADD

logFile.Operation = 'ADD(f)'

OF DriverOp:APPEND

logFile.Operation = 'APPEND(f)'

OF DriverOp:CLOSE

logFile.Operation = 'CLOSE(f)'

OF DriverOp:COPY

logFile.Operation = 'COPY(f,'''&CLIP(Parameters.Text)&''')'

OF DriverOp:CREATE

logFile.Operation = 'CREATE(f)'

OF DriverOp:DELETE

logFile.Operation = 'DELETE(f)'

OF DriverOp:NEXT

logFile.Operation = 'NEXT(f)'

OF DriverOp:OPEN

logFile.Operation = 'OPEN(f,'&Parameters.openMode&')'

OF DriverOp:PUT

logFile.Operation = 'PUT(f)'

OF DriverOp:SETkeykey

logFile.Operation = 'SET(k,k)'

END

ADD(logFile)

RETURN TRUE

!Этот метод вызывается после каждой операции с файлом данных.

!Он просто возвращает истину в соответствиями с правилами FileCallBackInterface.

FCB.FileCallBackInterface.FunctionDone |

PROCEDURE(SIGNED opCode, Params Parameters, *CSTRING ErrCode, *CSTRING ErrMsg)

CODE

RETURN TRUE

PROGRAM

INCLUDE('FILECB.INC')

MAP

viewTest(VIEW v)

check(STRING msg)

Test(STRING Name, FILE log, FILE f, VIEW v1, VIEW v2)

END

Dept FILE,DRIVER('Memory'),NAME('DEPT'),PRE(DEP),CREATE

PK_DEPT KEY(DEP:DEPTNO),PRIMARY

Record RECORD

DEPTNO BYTE

DNAME CSTRING(15)

LOC CSTRING(14)

END

END

LogFile FILE,DRIVER('ASCII'),CREATE,NAME('CB.LOG')

Record RECORD

Line STRING(100)

END

END

MyClass CLASS,IMPLEMENTS(FileCallBackInterface),TYPE

Name CSTRING(30),PRIVATE

logf &FILE,PRIVATE

baseF &FILE,PRIVATE

line ANY,PRIVATE

inView BOOL,PRIVATE

Init PROCEDURE(STRING n, FILE f, FILE log)

Kill PROCEDURE()

END

MemoryFile MyClass

ISAMView MyClass

iView1 VIEW(Dept).

iView2 VIEW(Dept).

CODE

CREATE(LogFile)

Check('Create LogFile')

OPEN(LogFile)

Check('OPEN LogFile')

MemoryFile.Init('Memory', Dept, LogFile)

ISAMView.Init('ISAMView', iView1, LogFile)

CREATE(Dept)

Check('Create Dept')

Test('Memory', LogFile, Dept, iView1, iView2)

MemoryFile.Kill()

ISAMView.Kill()

MESSAGE('Done')

viewTest PROCEDURE(VIEW v)

CODE

OPEN(v)

SET(v)

NEXT(v)

CLOSE(v)

Check PROCEDURE(STRING msg)

CODE

IF ERRORCODE()

IF ERRORCODE() = 90

HALT(1, msg & ' caused system error ' & FILEERRORCODE() & ' : ' |

& FILEERROR())

END

HALT(1, msg & ' caused error ' & ERRORCODE() & ' : ' & ERROR())

END

Test PROCEDURE(STRING msg, FILE log, FILE f, VIEW v1, VIEW v2)

g &GROUP

l ANY

CODE

g &= log{PROP:Record}

l &= WHAT(g, 1)

l = '!File Operations'

ADD(log)

OPEN(f)

Check(msg & ' OPEN')

SET(f)

NEXT(f)

l = '!View 1 Operations'

ADD(log)

viewTest(v1)

l = '!View 2 Operations'

ADD(log)

viewTest(v2)

l = '!Done'

ADD(log)

CLOSE(f)

MyClass.Init PROCEDURE(STRING n, FILE f, FILE log)

g &GROUP

CODE

CALLBACK(f, SELF.FileCallBackInterface)

SELF.logf &= log

SELF.basef &= f

SELF.Name = CLIP(n)

g &= SELF.logf{PROP:Record}

SELF.line &= WHAT(g, 1)

MyClass.Kill PROCEDURE()

CODE

CALLBACK(SELF.baseF, SELF.FileCallBackInterface, TRUE)

Check('Uncallback ' & SELF.Name)

SELF.line &= NULL

MyClass.FileCallBackInterface.FunctionCalled PROCEDURE(SIGNED opCode, |

*Params Parameters, *CSTRING ErrCode, *CSTRING ErrMsg)

p LIKE(Params)

f CSTRING(5),AUTO

logit BOOL(true)

CODE

p = Parameters

IF p.View &= NULL

f = 'FILE'

ELSE

f = 'VIEW'

END

CASE opCode

OF DriverOp:Create

SELF.line = 'CREATE(' & f & ' ' & SELF.Name & ')'

OF DriverOp:NEXT

SELF.line = 'NEXT(' & f & ' ' & SELF.Name & ')'

OF DriverOp:OPEN

SELF.line = 'OPEN(' & f & ' ' & SELF.Name & ','&Parameters.openMode&')'

OF DriverOp:PUT

SELF.line = 'PUT(' & f & ' ' & SELF.Name & ')'

OF DriverOp:VIEWSTART

SELF.InView = TRUE

logit = FALSE

OF DriverOp:VIEWSTOP

SELF.InView = FALSE

logit = FALSE

ELSE

logit = FALSE

END

IF logit AND ~SELF.InView

ADD(SELF.logF)

END

RETURN TRUE

MyClass.FileCallBackInterface.FunctionDone |

PROCEDURE(SIGNED opCode, Params Parameters, *CSTRING ErrCode, |

*CSTRING ErrMsg)

CODE

RETURN TRUE

CREATE(FILE Memory)

!File Operations

OPEN(FILE Memory,34)

NEXT(FILE Memory)

!View 1 Operations

OPEN(FILE ISAMView,34)

OPEN(VIEW Memory,34)

NEXT(FILE ISAMView)

NEXT(VIEW Memory)

!View 2 Operations

OPEN(VIEW Memory,34)

NEXT(VIEW Memory)

!Done

CODE

EXECUTE CHOICE()

END

CODE

EXECUTE CHOICE()

END

PROGRAM !Код программы Payroll

CODE

EXECUTE CHOICE()

END

Screen WINDOW,PRE(Scr)

ENTRY(@N3),USE(Ctl:Code)

ENTRY(@S30),USE(Ctl:Name)

BUTTON('OK'),USE(?OkButton),KEY(EnterKey)

BUTTON('Cancel'),USE(?CanxButton),KEY(EscKey)

END

CODE

OPEN(Screen)

ACCEPT

CASE EVENT()

OF EVENT:Selected

CASE SELECTED()

OF ?Ctl:Code

OF ?Ctl:Name

END

OF EVENT:Accepted

CASE ACCEPTED()

OF ?OkButton

BREAK

OF ?CanxButton

CLEAR(Ctl:Record)

BREAK

END

END

SaveHash LONG

Que QUEUE

Name STRING(10)

END

CODE

Que.Name = 'Jones'

ADD(Que) !Добавить запись

ASSERT(~ERRORCODE())

Que.Name = 'Jones II'

ASSERT(~ERRORCODE())

MESSAGE('CHANGES procedure worked correctly')

END

CODE

ACCEPT

RETURN !выход

END

END