|
|
Если Вы думаете, что ваша программа заслуживает внимания, пришлите мне ее. Интересные и оригинальные я опубликую для всего мира.
Прайс-лист - можно получить прямо здесь.
Информация о школе "ИнТеКО".
Информация о курсах.
Информация о выпускниках.
Информация о зачислении в школу.
' эта программа выводит на экран падающий снег. КРУТО.
SCREEN 9
tx = 297: ty = 0
n = 236: km = 1: cvet=11
DIM s(n), y1(n), y2(n), yp(n), x1(n), x2(n), r1(n), r2(n), B(n)
FOR i = 1 TO n
s(i) = RND * 6
r1(i) = RND * 1
y1(i) = RND * 200
x = RND * 640
x1(i) = x
b(i) = x
NEXT i
DO
FOR i = 1 TO n
IF INKEY$ <> "" THEN END
pset (x2(i), y2(i)), 0
yp(i) = yp(i) + s(i)
pset (x1(i), yp(i)), cvet
' меняя этот параметр можно добиться
' эффекта "сугробов"
visota=350
IF yp(i) > visota THEN yp(i) = 1: x1(i) = b(i)
y2(i) = yp(i): x2(i) = x1(i): r2(i) = r1(i)
NEXT i
LOOP
' эта программа выводит на экран вращающуюся спираль screen 9 do n=n+.01 for i=1 to 25 step .8 pset (400+sin(i*13+n-.01)*18,30+i*2),0 pset (400+sin(i*13+n)*18,30+i*2),12 pset (400+sin(i*13+n)*17,30+i*2),9 if inkey$<>"" then stop next i loop
' эта программа выводит на экран интересный эффект "зимних" цифр. КРУТО. screen 9 def seg=&hb800 randomize timer dim a(36,13), x6(3000) palette 3,0 color 3 locate 1,1:?"1998" for i=0 to 36 for j=0 to 13 a(i,j)=point(i,j) next j next i locate 1,1:?" " palette 3,24 rt=50:hj=1:xx3=15 for i=0 to 36 step .03 for j=1 to 13 step .2 if inkey$=" " then stop g1=rnd*RT g2=rnd*RT g3=rnd*RT g4=rnd*RT if a(i,j)<>0 then a(i,j)=9 line (17+i*19+i+g1+20,-7+j*14+g2+J+xx3)-(18+i*16+I+g3+20,-8+j*17+g4+j+xx3),a(i,j) if a(i,j)<>0 then a(i,j)=11 line (13+i*19+i+g1+20,-11+j*14+g2+J+xx3)-(14+i*16+I+g3+20,-12+j*17+g4+j+xx3),a(i,j) next j next i
' эта программа закрывает базы данных DBF уникальным паролем,
который хранит в файле DBF. КРУТО.
' сделать параметром любое число затем его всегда прибавлять
' тем самым пароль будет не нужен
cls
locate 1,1
rt$=ucase$(command$)
if rt$="" then
print " Lock/Unlock DBF. TMK. Copyright (c) 1998 by, Visual World Company & ИнТеКО."
print "":print " lock_dbf /? - помощь":stop
end if
if rt$="/?" then
print " Lock/Unlock DBF. TMK. Copyright (c) 1998 by, Visual World Company & ИнТеКО."
? ""
? " Эта программа предназначена для временной защиты файлов DBF от"
? " просмотра и изменения в момент, когда Вас нет за компьютером."
? " Один запуск программы закрывает базы для изменения, другой"
? " открывает их."
? " Будьте осторожны, если вы ошибетесь с кодом программа закроет"
? " базу еще одним кодом, если все же Вы ошиблись и база не откры-"
? " вается, повторите запуск с неверным кодом. Затем введите пра-"
? " вильный код."
? " Программа запускается со следующими параметрами:"
? ""
? " /? - помощь"
? " /s - запуск программы без сообщений"
? " /a - авторские права"
? "kod - специальный код для установки и снятия защиты. Это Ваш"
? " код, запомните его, теперь для открытия баз необходимо"
? " запускать программу lock_dbf с этим кодом. Код должен"
? " находится в интервале от 100 до 140"
? ""
? "Пример запуска программы: lock_dbf.exe [/?] [/a] [/s] [kod]"
? " lock_dbf.exe /s 24
stop
end if
if rt$="/A" then
print " Lock/Unlock DBF. TMK. Copyright (c) 1998 by, Visual World Company & ИнТеКО."
? ""
? " Эта программа предназначена для временной защиты файлов DBF от"
? " просмотра и изменения в момент, когда Вас нет за компьютером."
? " Один запуск программы закрывает базы для изменения, другой"
? " открывает их. Для того, чтобы защитить все базы Вам необходимо"
? " защитить только один файл (поставьте на него пароль и все).
? " "
? " Программа распространяется бесплатно."
? " "
? " Все впечатления прошу направлять по адресу:"
? " "
? " г. Тольятти, б-р Буденного, д.5, кв.25"
? " Фоломкину Алексею Ивановичу"
? " "
? " tmk@infopac.ru & vwc_vwc@chat.ru"
end if
if left$(rt$,2)<>"/S" then stop
l=len(rt$)
k$=right$(rt$,l-3)
' hr - это код введенный в параметрах при запуске
hr=val(k$)
' пеpеменная - число код в стpоке
if hr<100 or hr>140 then
print " Lock/Unlock DBF. TMK. Copyright (c) 1998 by, Visual World Company & ИнТеКО."
print "":print " lock_dbf /? - помощь":stop
stop
end if
kkl=hr
if left$(rt$,2)="/S" and mid$(rt$,3,1)=" " then
shell "dir *.dbf /l /b > read.dan"
open "read.dan" for append as#2:close #2
dim f$(2000)
open "read.dan" for input as#2
i=0
do
if eof(2) then exit2
i=i+1
input #2,f$(i)
loop
exit2:
close #2
if i=0 then exit3
for j=1 to i
open f$(j) for binary as #1
g=1
get$ #1,g,f$
g=0
seek #1,g
k=asc(left$(f$,1))
l$=chr$(255-k-50+kkl)
put$ #1,l$
close #1
next j
exit3:
shell "del read.dan >nul"
end if