Как сохранить определения индексов и фильтров для таблиц в текущем каталоге
Эли Линков
* INDEXSAV.PRG
* Эта программа может быть использована
* для создания справочника
* по всем индексам и фильтрам в каталоге
* проекта. Таблица, куда записывается
* информация, называется DBINFO.DBF.
* Структура справочника
* поле dbfname 12 символов
* поле infomemo memo
*
* В memo-поле помещается имя индекса,
* выражение индексации и дополнительное
* ограничение индексного выражения
* в виде <имя индекса>/<выражение>%<фильтр>,
* определение одного индекса занимает
* строку в memo-поле
*
* Программу следует запускать
* когда приложение готово к инсталляции,
* она создаст справочник и
* соответствующий FPT-файл.
* Этот справочник нужно хранить
* в "системном" каталоге приложения
* вместе с исполняемой версией
* программы INDEXMAK.
* INDEXMAK.EXE должна быть доступна
* только через меню администратора
* и не должна появляться как пиктограмма
* в окне Program Manager.
* Для восстановления индексов
* нужно запустить программу INDEXMAK.EXE
CLOSE DATABASES
* Следующие две строки указывают
* на системные каталоги проекта
datapath = ;
GETDIR("",'Where the indexed tables')
workpath = ;
GETDIR("",'Where the system EXE is')
IF NOT FILE(workpath + "dbfinfo.dbf")
SET DEFAULT TO (workpath)
* создаем таблицу-справочник
* (используется программой INDEXMAK.PRG)
CREATE TABLE dbfinfo ;
(dbfname C(12), infomemo m)
ENDIF
SET DEFAULT TO &datapath
DIMENSION filelist(1)
=ADIR(filelist,"*.dbf")
CLOSE data
set DEFAULT TO &workpath
SELECT 0
USE dbfinfo EXCLUSIVE
SET SAFETY OFF
ZAP
SET SAFETY ON
APPEND FROM ARRAY filelist
RELEASE filelist
GO TOP
SET DEFAULT TO &datapath
SCAN
TEXT = ALLTRIM(dbfname)
IF TEXT = "DBFINFO.DBF"
ELSE
REPLACE dbfname ;
WITH LEFT(TEXT,LEN(TEXT) - 4)
SELECT 0
USE ALLT((dbfinfo.dbfname)) EXCLUSIVE
DIMENSION taglist(1,3)
indexstr = ""
arrct = 1
DO WHILE NOT EMPTY(TAG(arrct))
taglist(arrct,1) = TAG(arrct)
* имя индекса
taglist(arrct,2) = SYS(14,arrct)
* выражение индексации
taglist(arrct,3) = SYS(2021,arrct)
* фильтр индексации (если есть)
arrct = arrct + 1
DIMENSION taglist(arrct,3)
ENDDO
SELECT dbfinfo
FOR x = 1 TO arrct - 1
indexstr=indexstr+taglist(x,1) ;
+"/"+taglist(x,2);
+"%"+taglist(x,3)+CHR(13)
ENDFOR
REPLACE infomemo WITH indexstr
ENDIF
ENDSCAN
SET DEFAULT TO &workpath
CLOSE DATA
PROCEDURE INDEXMAK
* indexmak.prg
* Эта программа используется
* для восстановления индексов
* в том случае, если таблицы проекта
* оказались повреждены.
* Программа использует справочник DBFINFO.DBF,
* созданный программой INDEXSAV.PRG,
* для восстановления имен индексов,
* выражений индексации и фильтров индексов.
*
* Программу нужно поместить в виде
* исполняемого файла и дать доступ к ней
* только администратору системы.
*
CLOSE DATABASES
* путь к "системному" каталогу проекта
* (укажите свой путь)
datapath = "C:\sxc\sxcbuild\"
workpath = "c:\sxc\sxcmaint\"
SET DEFAULT TO &workpath
SELECT 0
USE dbfinfo EXCLUSIVE
SET SAFETY OFF
GO TOP
SET DEFAULT TO &datapath
SCAN
TEXT = ALLTRIM(dbfname)
IF TEXT = "DBFINFO.DBF"
ELSE
SELECT 0
USE (dbfinfo.dbfname) EXCLUSIVE
DELETE TAG ALL
memct = 1
fred = dbfinfo.infomemo
IF NOT EMPTY(fred)
DO WHILE NOT EMPTY ;
(MLINE(dbfinfo.infomemo,memct))
fred = ALLTRIM ;
(MLINE(dbfinfo.infomemo,memct))
colno1 = AT("/",fred)
colno2 = AT("%",fred)
tagfield = LEFT(fred,colno1 - 1)
* имя индекса
tagname = SUBSTR(fred,colno1 + 1,;
(colno2 - colno1 - 1))
* выражение индексации
tagfilt = ALLTRIM ;
(RIGHT(fred,LEN(fred) - colno2))
* фильтр индексации
IF tagfilt <> ""
INDEX ON &tagfield ;
FOR &tagfilt TAG &tagname
ELSE
INDEX ON &tagfield TAG &tagname
ENDIF
memct = memct + 1
ENDDO
ENDIF
ENDIF
ENDSCAN
SET DEFAULT TO &workpath
SET SAFETY ON
CLOSE DATA
Пароли
* Пример 1
* (Брайан Копеланд /Brian Copeland/)
* Это пример использования INKEY()
* для ввода пароля и вывода '*' в поле.
CLEAR
mpassword=''mshowpass=''
@ 10,10 GET mshowpass DEFAULT '' ;
SIZE 1,10 WHEN checkpass()
READ
PROCEDURE checkpass
DO WHILE .T.
mkey=INKEY(0)
DO CASE
CASE mkey=13
* нажата ENTER
EXIT
CASE BETWEEN(mkey,48,57)
* это число
mpassword=mpassword+CHR(mkey)
mshowpass = mshowpass+'*'
CASE BETWEEN(mkey,97,122)
* это буква в нижнем регистре
mpassword=mpassword+CHR(mkey)
mshowpass = mshowpass+'*'
CASE BETWEEN(mkey,65,90)
* это буква в верхнем регистре
mpassword=mpassword+CHR(mkey)
mshowpass = mshowpass+'*'
CASE mkey=127
* нажата backspace
mpassword=;
LEFT(mpassword,LEN(mpassword)-1)
mshowpass=;
LEFT(mshowpass,LEN(mshowpass)-1)
ENDCASE
SHOW GETS
ENDDO
CLEAR READ
* Пример 2 (Р. Премкумар /R. Premkumar/)
*
* Процедура проверки ввода пароля:
* если пароль верен, возвращает .t.,
* иначе возвращает .f.
* или включает системы защиты (сирену)
* n = максимальная длина пароля,
* по вашему усмотрению
* c = строка, которая появляется
* по мере ввода пароля
* (вместо звездочек вы можете увидеть текст
* "С добрым утром", который появляется
* по мере ввода пароля
* t = заголовок окна
PROCEDURE password
PARAMETERS N,C,t
PRIVATE ALL
IF (PARA()>0 AND TYPE('n') #'N') OR (PARA()>1 ;
AND TYPE('c') #'C') OR ;
(PARA()>2 AND TYPE('t') #'C')
WAIT WINDOW NOWAIT ;
'Usage : ? PASSWORD( [ <length> ' +;
'[, <display string> [, <title> ]]] )'
* в программе вы можете вызвать
* эту функцию как: a=password()
RETURN
ENDIF
IF PARA()=0
N=7
* длина пароля по умолчанию.
* Используется при вызове функции
* без параметров
ENDIF
IF PARA()<3
t='ENTER PASSWORD' && Заголовок по умолчанию
ENDIF
DEFINE WINDOW paswrd DOUBLE TITLE t ;
FROM 11,IIF(MAX(N,LEN(t))<10,30,CEIL ;
(35-MAX(N,LEN(t))/2)) ;
TO 13,IIF(MAX(N,LEN(t))<10,50,;
CEIL(45+MAX(N,LEN(t))/2))
ACTIVATE WINDOW paswrd
SET COLOR TO x/N
cd=IIF(PARA()<2,REPL('*',N),PADR(C,N,'.'))
* по умолчанию выводим звездочки
ps=""
FOR i=1 TO N
@0,5+I
p=INKEY(0)
DO CASE
CASE LAST()=127 && backspace
IF i>1
@0,5+i-1 SAY " "
ps=LEFT(ps,LEN(ps)-1)
ENDIF
i=i-2
i=IIF(i<0,0,i)
CASE LAST()=13 && Return
EXIT
OTHERWISE
@0,5+i SAY SUBSTR(cd,i,1) COLOR W/N
ps=ps+CHR(p)
ENDCASE
ENDFOR
SET COLOR TO
RELEASE WINDOW paswrd
RETURN ps