Идея языка
Разработаем новый язык программирования на Visual Basic’е. Назовём его RIPL (это рекодируемый промежуточный язык программирования высокого уровня, идея которого разработана в Калифорнийском Техническом Университете). Идея этого языка очень проста: программа имеет специальную структуру. При компиляции (RIPLC.exe) создаётся копия файла RIPLC.exe с именем компилируемой программы (например, sample1.ripl -> sample1.exe), исходный код каким-либо образом сжимается или шифруется (здесь можно придумать много вариантов) и записывается в конец этого exe-файла после специального набора символов (будем использовать слово ‘YXINE’). Этот набор символов будет нужен для поиска начала программы при трансляции. Нужно отметить, что файл RIPLC.exe будет использоваться как для компилирования, так и для транслирования, а также содержать в себе исходный код программы. Это позволит легко рекодировать исходный код программы (т.е. видоизменять исходный код в ходе выполнения программы). Это даёт возможность программисту писать программы, которые трудоёмкие для написания на других языках программирования. Несколько таких программ будут рассмотрены в конце статьи.
Достоинства языка
- Быстрая скорость компилирования и транслирования
- Исходный код сжимается, шифруется или преобразуется любым иным способом или комбинацией способов -> можно хорошо уменьшить большие программы и их нельзя будет взломать (если использовать стойкий метод шифрования).
- Возможность рекодирования исходного кода даже в откомпилированной программе
Недостатки языка
- При добавлении новых команд в язык, мы тем самым увеличиваем размер RIPLC.exe и получаем большие exe-файлы (более 80 кбайт для самой простой программы). Хотя этот exe-файл можно дополнительно сжать такой программой, например, как UPX.
Структура программы на языке RIPL
В тэгах < > будет указываться то, что должен ввести программист.
Текст между ... может быть продублирован несколько раз (например, может существовать несколько типов и процедур/функций).
Между [ ] стоит текст, который необязателен. Всё, что находится вне этих символов – обязательно.
Program <имя_программы>
...
[Type <имя_типа>
...
<тип_переменной> <имя_переменной_1>,...,<имя_переменной_N>
...
Epyt]
...
[Var
...
<тип_переменной> <имя_переменной_1>[,...,<имя_переменной_N>]
...
Rav]
...
[Proc [<тип_возвращаемого_значения>] <имя_процедуры/функции>
[Params
...
<тип_параметра> <имя_параметра_1>[,...,<имя_параметра_N>]
...
smarap]
...
<какие_то_операции>
...
Corp]
...
Proc Main
...
<какие_то_операции>
...
Corp
Минимальная программа выглядит так:
Program RIPL1
Proc main
Corp
Для более детального знакомства со структурой RIPL-программы, можно разобрать примеры, которые приведены в конце статьи.
Как видно из структуры – RIPL-программа не имеет локальных переменных. Есть только глобальные. Что касается типов переменных:
| Имя типа
|
Диапозон значений и описание
|
Номер в реализации
|
| Boolean
|
True или False
|
249
|
| Byte
|
0..255
|
250
|
| Integer
|
От -2,147,483,648 до 2,147,483,647
|
251
|
| Real
|
От -1.79769313486232E308 дo -4.94065645841247E-324 и от 4.94065645841247E-324 до 1.79769313486232E308 for positive values.
|
252
|
| Date
|
Любая дата (день.месяц.год) + время (час:минута:секунда)
|
253
|
| String
|
От 0 до 2 миллиардов символов
|
254
|
| Variant
|
Переменная любого из перечисленных типов
|
255
|
| ...
|
Зарезервированы (на будущее)
|
248-201
|
| ...
|
Типы пользователя (те, которые создаются в разделе Type)
|
200-1
|
| ...
|
Неидентифицированное значение
|
0
|
Реализация компилятора-транслятора
Option Explicit
Сначала рассмотрим все используемые типы, глобальные переменные и api-функции:
Global PrgPath As String ‘путь к нашей программе
Global cmd As String ‘параметры командной строки
Global RIPLCode() As String ‘динамический массив для временного хранения исходного кода
Global P As Program ’структура для программы
Global ProcNum As Integer ‘номер процедуры, в которой мы находимся (при транслировании)
Global ProcPos As Integer ‘номер строки в процедуре где мы находимся (при транслировании)
Private Huffman As sicHuffman ‘будем сжимать исходный код по методу Huffman’а
Type FILETIME ‘тип используется в типе WIN32_FIND_DATA
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Type WIN32_FIND_DATA ‘тип используется в api-функции FindFirstFile
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260
cAlternate As String * 14
End Type
Теперь идут самые главные типы – в них будет храниться исходный код ripl-программы. В эту структуру он будет заноситься при транслировании
Type USERTYPE ‘подструктура пользовательских типов
Name As String ‘имя типа
RecordName() As String ‘массив имён записей
RecordType() As Integer ‘массив типов данных для записей (см. таблицу выше)
RecordsCount As Integer ‘количество записей в типе
End Type
Type VarType ‘подструктура для глобальных переменных
VarName As String ‘имя переменной
VarType As Integer ‘тип переменной
VarValue As Variant ‘значение переменной
End Type
Type PROCTYPE ‘подструктура для процедур/функций
Name As String ’имя процедуры/функции
pType As Integer ‘тип возвращаемого значения
Parameter() As VarType ‘массив параметров
ParametersCount As Integer ‘количество параметров
Code() As String ‘массив для кода процедуры/функции
CodesCount As Integer ‘количество строк кода в процедуре/функции
End Type
Type Program ‘структура RIPL-программы
Name As String ‘имя программы
uType() As USERTYPE ‘массив пользовательских типов
uTypesCount As Integer ‘количество пользовательских типов
Var() As VarType ‘массив глобальных переменных
VarsCount As Integer ‘количество глобальных переменных
Proc() As PROCTYPE ‘массив процедур/функций
ProcsCount As Integer ‘количество процедур/функций
End Type
API-функции. Эти две нужны для преобразования параметров командной строки (см. LongFileName)
Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Превращаем dos-имя файла (8.3) в windows-имя файла
Private Function LongFileName(ByRef FilePath As String) As String
Dim hFind As Long
Dim WFD As WIN32_FIND_DATA
hFind = FindFirstFile(FilePath, WFD)
If hFind <> -1 Then
LongFileName = LeftB$(WFD.cFileName, InStrB(WFD.cFileName, vbNullChar))
FindClose hFind
End If
End Function
Возвращает имя файла с заменённым на exe расширением
Private Function FNWE(S As String) As String
S = LongFileName(S)
FNWE = Mid(cmd, 1, InStrRev(cmd, "\")) & Mid(S, 1, InStrRev(S, ".") - 1) & ".exe"
End Function
Ну вот, и начало компилирования/транслирования!
Sub Main()
On Error Resume Next
Set Huffman = New sicHuffman
Dim Tet As String
Dim Code() As Byte
Dim FF
Dim Size As Long
Dim CodeStart As Long
Dim IsComment As Boolean
Dim IsText As Boolean
Dim I As Long
Dim PrevCode As Byte
PrgPath = LCase(Trim(App.Path)) ‘получаем путь к нашей программе
If Right(PrgPath, 1) <> "\" Then PrgPath = PrgPath & "\"
FF = FreeFile
Считываем сами себя (содержимое запущенного exe-файла) в переменную
Open PrgPath & App.EXEName & ".exe" For Binary As #FF
Size = LOF(FF)
** Tet = Input(Size, #FF)
Close #FF
Находим наше специальное слово, указывающее на начало исходного кода
CodeStart = InStr(1, Tet, "YXINE", vbTextCompare)
If CodeStart = 0 Then
указатель не найден - значит мы в оригинальном файле (копия RIPLC.exe), который ещё не содержит исходный код -> записываем исходный код в конец exe-программы. Имя файла, содержащего исходный код передаётся в командной строке (например, sample1.ripl). Его-то и будет обрабатывать.
cmd = LCase(Command)
cmd = LCase(Trim(Replace(cmd, Chr(34), "")))
Если имя файла не передали в командной строке, то работа окончена - выходим
* If cmd = "" Or FileLen(cmd) = 0 Then End
Делаем копию компилятора/транслятора (RIPLC.exe -> sample1.exe)
FileCopy PrgPath & App.EXEName & ".exe", FNWE(cmd)
Считываем исходный код в байтовый массив
Open cmd For Binary As #FF
ReDim Code(1 To LOF(FF))
Get #FF, , Code()
Close #FF
Теперь надо избавиться от мусора в исходном коде. Т.е. убрать комментарии, лишни пробелы и т.п. Они ведь не нужны в exe-файле, плюс это сильно уменьшит размер исходного кода.
IsComment = False
IsText = False
CodeStart = 1
PrevCode = 0
For I = 1 To UBound(Code(), 1)
Select Case Code(I)
Case 39 '
If Not IsText Then IsComment = True
PrevCode = Code(I)
Case 34
If Not IsComment Then
IsText = Not IsText
Code(CodeStart) = 34
CodeStart = CodeStart + 1
PrevCode = Code(I)
End If
Case 13, 10
If PrevCode <> 10 Then
IsText = False
IsComment = False
Code(CodeStart) = Code(I)
CodeStart = CodeStart + 1
PrevCode = Code(I)
End If
Case 32 'space
If IsText Then
Code(CodeStart) = 32
CodeStart = CodeStart + 1
PrevCode = Code(I)
End If
Case Else
If Not IsComment Then
If IsText Then
Code(CodeStart) = Code(I)
CodeStart = CodeStart + 1
Else
Code(CodeStart) = CByte(Asc(LCase(Chr(Code(I)))))
CodeStart = CodeStart + 1
End If
PrevCode = Code(I)
End If
End Select
Next
CodeStart = CodeStart – 1 ‘в этой переменной хранится длина исходника
ReDim Preserve Code(1 To CodeStart) ‘корректируем размер массива (исходник уменьшился)
Сохраняем очищенный исходник во временный файл и сжимаем его. В принципе здесь можно дать волю воображению и сделать с файлом любое другое преобразование. Например, зашифровать или сжать Rar’ом и т.д. Но надо помнить, что придётся изменить и обратное преобразование соответствующим образом (см. далее по программе). После сжатия, опять считываем файл в байтовый массив.
Open Environ("temp") & "\tmp" For Binary As #FF
Put #FF, , Code()
Close #FF
Call Huffman.EncodeFile(Environ("temp") & "\tmp", Environ("temp") & "\tmp2")
Open Environ("temp") & "\tmp2" For Binary As #FF
ReDim Code(1 To LOF(FF))
Get #FF, , Code()
Close #FF
Kill Environ("temp") & "\tmp" ‘удаляем мусор
Kill Environ("temp") & "\tmp2"
Теперь записываем преобразованный исходник в конец exe-файла после специального слова ‘YXINE’
Open FNWE(cmd) For Binary Access Write As FF
Put #FF, Size + 1, "YXINE"
Put #FF, Size + 6, Code()
Close #FF
Всё! Компилирование окончено! Завершаем работу программы.
Else
Теперь вернёмся к проверке существования указателя (см. *). Если указатель найден, то мы находимся в скомпилированном файле, в конце которого хранится исходник -> вытаскиваем его! Для этого находим адрес, где хранится его начало, и считываем нужное количество символов из tet – здесь хранится содержимое нашего exe-файла (см. **)
Tet = Mid(Tet, CodeStart + 5, Size - CodeStart - 4)
Исходник считан. Сохраняем его и разжимаем (N.B.!!!)
Open Environ("temp") & "\tmp" For Output As #FF
Print #FF, Tet
Close #FF
Call Huffman.DecodeFile(Environ("temp") & "\tmp", Environ("temp") & "\tmp2")
Теперь заносим считанный исходный код в массив RIPLCode построчно
CodeStart = 1
Open Environ("temp") & "\tmp2" For Input As #FF
Do While Not EOF(FF)
Line Input #FF, Tet
If Tet <> "" Then
ReDim Preserve RIPLCode(1 To CodeStart)
RIPLCode(CodeStart) = Tet
CodeStart = CodeStart + 1
End If
Loop
Close #FF
CodeStart = CodeStart - 1
Kill Environ("temp") & "\tmp"
Kill Environ("temp") & "\tmp2"
Надо занести исходный код в специальную структуру (ту, что описана в Type’ах)
ParseProgramToStructure
End If
End Sub
Делается это очень просто. Т.к. RIPL-структура очень хорошо разделена на блоки (Type, Var, Proc), то, во-первых, по мере движения по исходному коду надо определять в каком из этих блоков мы находимся, во-вторых, в зависимости от блока, обрабатывать текущую строку в соответствующих процедурах, т.е. для обработки секции Var будем использовать процедуру ParseVar, для Type – ParseType, для Proc – ParseProc. Это разделение удобно и все три процедуры очень похожи друг на друга.
Sub ParseProgramToStructure()
Dim I As Long
Dim isType As Boolean
Dim isVar As Boolean
Dim isProc As Boolean
isType = False
isVar = False
isProc = False
P.uTypesCount = 0
P.VarsCount = 0
P.ProcsCount = 0
If Left(RIPLCode(1), 7) = "program" Then
P.Name = Right(RIPLCode(1), Len(RIPLCode(1)) - 7)
Else
MsgBox "Program Name Is Missing..." ‘сразу отлавливаем ошибки
End If
For I = 2 To UBound(RIPLCode(), 1)
If Left(RIPLCode(I), 4) = "type" Then
isType = True
P.uTypesCount = P.uTypesCount + 1 ‘увеличиваем счётчик типов на 1
ReDim Preserve P.uType(1 To P.uTypesCount)
P.uType(P.uTypesCount).Name = Right(RIPLCode(I), Len(RIPLCode(I)) - 4)
P.uType(P.uTypesCount).RecordsCount = 0
GoTo NextI
End If
If ((Len(RIPLCode(I)) = 3) And (Left(RIPLCode(I), 3) = "var")) Then
isVar = True
GoTo NextI
End If
If ((Len(RIPLCode(I)) = 3) And (Left(RIPLCode(I), 3) = "rav")) Then
isVar = False
GoTo NextI
End If
If ((Len(RIPLCode(I)) = 4) And (Left(RIPLCode(I), 4) = "epyt")) Then
isType = False
GoTo NextI
End If
If ((Len(RIPLCode(I)) = 4) And (Left(RIPLCode(I), 4) = "corp")) Then
isProc = False
GoTo NextI
End If
If Left(RIPLCode(I), 4) = "proc" Then
isProc = True
P.ProcsCount = P.ProcsCount + 1
ReDim Preserve P.Proc(1 To P.ProcsCount)
P.Proc(P.ProcsCount).CodesCount = 0
P.Proc(P.ProcsCount).ParametersCount = 0
P.Proc(P.ProcsCount).VarsCount = 0
ParseProc RIPLCode(I) ‘обрабатываем процедуру/функцию
GoTo NextI
End If
If ((Not isProc) And (isType)) Then ParseType RIPLCode(I) ‘-||- Type
If ((Not isProc) And (isVar)) Then ParseVar RIPLCode(I) ‘-||- Var
If isProc Then
P.Proc(P.ProcsCount).CodesCount = P.Proc(P.ProcsCount).CodesCount + 1
ReDim Preserve P.Proc(P.ProcsCount).Code(1 To P.Proc(P.ProcsCount).CodesCount)
P.Proc(P.ProcsCount).Code(P.Proc(P.ProcsCount).CodesCount) = RIPLCode(I)
End If
NextI:
Next
Структура создана! Начинаем её транслировать (см. RunProgram)!
RunProgram
End Sub
Не будем разбирать принцип действия процедур ParseType, ParseVar и ParseProc. Они похожи и, думаю, вы сами сможете разобраться как они работают. Просто приведу их:
Function VarType(ByRef S As String) As Integer
VarType = 0
If Left(S, 7) = "boolean" Then
VarType = 249
S = Right(S, Len(S) - 7)
End If
If Left(S, 4) = "byte" Then
VarType = 250
S = Right(S, Len(S) - 4)
End If
If Left(S, 7) = "integer" Then
VarType = 251
S = Right(S, Len(S) - 7)
End If
If Left(S, 4) = "real" Then
VarType = 252
S = Right(S, Len(S) - 4)
End If
If Left(S, 4) = "date" Then
VarType = 253
S = Right(S, Len(S) - 4)
End If
If Left(S, 6) = "string" Then
VarType = 254
S = Right(S, Len(S) - 6)
End If
If Left(S, 7) = "variant" Then
VarType = 255
S = Right(S, Len(S) - 7)
End If
S = S & ","
End Function
Sub ParseType(S As String)
On Error Resume Next
Dim I As Integer, J As Integer, Zap As Integer, Old As Integer, vType As Integer
For I = 1 To P.uTypesCount - 1
If Len(P.uType(I).Name) < S Then
If Mid(S, 1, Len(P.uType(I).Name)) = P.uType(I).Name Then
vType = I
S = Right(S, Len(S) - Len(P.uType(I).Name)) & ","
VarCount1: Zap = 0
For J = 1 To Len(S)
If Mid(S, J, 1) = "," Then Zap = Zap + 1
Next
If Zap = 0 Then Zap = 1
'т.е. мы имеем Zap переменных
Old = P.uType(P.uTypesCount).RecordsCount
P.uType(P.uTypesCount).RecordsCount = Old + Zap
ReDim Preserve P.uType(P.uTypesCount).RecordName(1 To P.uType(P.uTypesCount).RecordsCount)
ReDim Preserve P.uType(P.uTypesCount).RecordType(1 To P.uType(P.uTypesCount).RecordsCount)
For J = 1 To Zap
P.uType(P.uTypesCount).RecordType(Old + J) = vType
P.uType(P.uTypesCount).RecordName(Old + J) = Mid(S, 1, InStr(1, S, ",") - 1)
If J <> Zap Then S = Mid(S, InStr(1, S, ",") + 1, Len(S) - InStr(1, S, ","))
Next
Exit Sub
End If
End If
Next
vType = VarType(S)
GoTo VarCount1
End Sub
Sub ParseVar(S As String)
On Error Resume Next
Dim I As Integer, J As Integer, Zap As Integer, Old As Integer, vType As Integer
For I = 1 To P.uTypesCount ' - 1
If Len(P.uType(I).Name) < S Then
If Mid(S, 1, Len(P.uType(I).Name)) = P.uType(I).Name Then
vType = I
S = Right(S, Len(S) - Len(P.uType(I).Name)) & ","
VarCount2: Zap = 0
For J = 1 To Len(S)
If Mid(S, J, 1) = "," Then Zap = Zap + 1
Next
If Zap = 0 Then Zap = 1
Old = P.VarsCount
P.VarsCount = Old + Zap
ReDim Preserve P.Var(1 To P.VarsCount)
ReDim Preserve P.Var(1 To P.VarsCount)
For J = 1 To Zap
P.Var(Old + J).VarType = vType
P.Var(Old + J).VarName = Mid(S, 1, InStr(1, S, ",") - 1)
If J <> Zap Then S = Mid(S, InStr(1, S, ",") + 1, Len(S) - InStr(1, S, ","))
Next
Exit Sub
End If
End If
Next
vType = VarType(S)
GoTo VarCount2
End Sub
Sub ParseProc(S As String)
Dim isParameters As Boolean, J As Integer
Dim vType As Integer
isParameters = False
S = Right(S, Len(S) – 4)
If Right(S, 3) = "var" Then
isParameters = True
S = Left(S, Len(S) - 3)
Else
isParameters = False
End If
For J = 1 To P.uTypesCount
If Len(P.uType(J).Name) < Len(S) Then
If Mid(S, 1, Len(P.uType(J).Name)) = P.uType(J).Name Then
'usertype
vType = J
S = Right(S, Len(S) - Len(P.uType(J).Name))
GoTo NextII
End If
End If
Next
vType = VarType(S)
NextII:
P.Proc(P.ProcsCount).Name = Left(S, Len(S) - 1)
P.Proc(P.ProcsCount).pType = vType
End Sub
Итак, начинаем транслировать программу
Sub RunProgram()
Запускаем цикл по количеству процедур/функций и находим sub main – с неё начинается выполняться программа
For ProcNum = 1 To P.ProcsCount
If P.Proc(ProcNum).Name = "main" Then GoTo Translate
Next
MsgBox "Не найдена главная процедура Main", vbCritical, "Ошибка..."
End
Translate:
Запускаем цикл по количеству строк кода в процедуре sub main и посылаем каждую строку на обработку процедуре ParseCommand.
For ProcPos = 1 To P.Proc(ProcNum).CodesCount
ParseCommand P.Proc(ProcNum).Code(ProcPos)
DoEvents
Next
Заметьте, что переменные ProcPos и ProcNum – глобальные. Это сделано для упрощения написания операторов безусловного перехода (Goto, например). Посмотрите, как просто в таком случае написана команда Goto (см. RIPL_Goto).
End Sub
Sub ParseCommand(ByVal S As String)
Dim I As Integer, J As Integer
Dim Var As String, Value As Variant
В этой процедуре мы транслируем одну строку исходника. Будем делать много проверок, выясняя, какую же команду надо выполнить. Сначала поработаем с переменными:
I = InStr(1, S, "=") 'операция присваивания?
If I <> 0 Then
J = InStr(1, S, Chr(34))
If J = 0 Or J > I Then
For J = 1 To P.VarsCount
If P.Var(J).VarName = Left(S, I - 1) Then
Select Case P.Var(J).VarType
Case 255: P.Var(J).VarValue = CVar(Right(S, Len(S) - I))
Case 254
S = Replace(S, Chr(34), "")
P.Var(J).VarValue = CStr(Right(S, Len(S) - I))
Case 253: P.Var(J).VarValue = CDate(Right(S, Len(S) - I))
Case 252: P.Var(J).VarValue = CDbl(Right(S, Len(S) - I))
Case 251: P.Var(J).VarValue = CLng(Right(S, Len(S) - I))
Case 250: P.Var(J).VarValue = CByte(Right(S, Len(S) - I))
Case 249: P.Var(J).VarValue = CBool(Right(S, Len(S) - I))
'Case Else: P.Var(J) = Right(S, Len(S) - I)
End Select
Exit Sub
End If
Next
MsgBox "Переменная " & Left(S, I - 1) & " не продекларирована", vbCritical, "Ошибка..."
End If
End If
Теперь работаем с операторами:
If ((Len(S) = "3") And (S = "cls")) Then
RIPL_Cls
Exit Sub
End If
If (Left(S, 5) = "print") Then
RIPL_Print ParseSubCommand(Right(S, Len(S) - 5))
Exit Sub
End If
Процедура ParseSubCommand делает очень полезную вещь! Рассмотрим команды:
Print “Hello, World!” и Print “Hello,” + cs(32) + “World!”
Результат работы один и тот же, а написано по разному. Из примера видно, что перед тем как выполнять внешнюю команду (Print) надо выполнить все внутренние (cs). Эту работу проделывает процедура parseSubCommand. Я не буду её приводить, т.к. она громоздкая (+сложная). Пусть её написание будет вашим домашним заданием. Намекну лишь, что она очень похожа на ParseCommand + рекурсивно вызывает ParseCommand и саму себя. Принцип её действия основан на нахождении конструкций типа ( ... ) и кавычек.
If (Left(S, 1) = "?") Then
RIPL_Print ParseSubCommand(Right(S, Len(S) - 1))
Exit Sub
End If
If ((Left(S, 4) = "jump") Or (Left(S, 4) = "goto")) Then
RIPL_Goto Right(S, Len(S) - 4)
Exit Sub
End If
If ((Len(S) = "3") And (S = "end")) Then End
If Left(S, 11) = "file.delete" Then
RIPL_File_Delete ParseSubCommand(Right(S, Len(S) - 11))
Exit Sub
End If
If Left(S, 11) = "output.show" Then
RIPL_Output_Show
Exit Sub
End If
If Left(S, 11) = "output.hide" Then
RIPL_Output_Hide
Exit Sub
End If
If Left(S, 5) = "input" Then
RIPL_Input Right(S, Len(S) - 5)
Exit Sub
End If
If S = "doevents" Then
DoEvents
Exit Sub
End If
Ну и так далее до бесконечности. Вы можете добавлять свои новые команды в язык RIPL. Тогда вам нужно в этой процедуре вести проверку на вызов этой новой команды, и написать соответственную процедуру или функцию для её обработки.
End Sub
Приведу пример обработки некоторых команд:
Sub RIPL_Cls()
Dim I As Integer
For I = 1 To Output.OutputLbl.Count – 1 ‘действие происходит на форме Output
Unload Output.OutputLbl(I)
Next
End Sub
Sub RIPL_Print(ByVal S As String)
Dim I As Integer
S = Replace(S, Chr(34), "")
If (Output.OutputLbl.Count) * 200 > Output.ScaleHeight Then
'прокрутка текста вверх
For I = 1 To Output.OutputLbl.Count - 2
Output.OutputLbl(I).Caption = Output.OutputLbl(I + 1).Caption
Next
Output.OutputLbl(Output.OutputLbl.Count - 1).Caption = S
Output.OutputLbl(Output.OutputLbl.Count - 1).ForeColor = ForeColor
Else
Load Output.OutputLbl(Output.OutputLbl.Count)
Output.OutputLbl(Output.OutputLbl.Count - 1).Caption = S
Output.OutputLbl(Output.OutputLbl.Count - 1).Top = (Output.OutputLbl.Count - 2) * 200
Output.OutputLbl(Output.OutputLbl.Count - 1).ForeColor = ForeColor
Output.OutputLbl(Output.OutputLbl.Count - 1).Visible = True
End If
End Sub
N.B.!!!
Sub RIPL_Goto(ByVal S As String)
Dim I As Integer, j As Integer
For I = 1 To P.ProcsCount
For j = 1 To P.Proc(I).CodesCount
If P.Proc(I).Code(j) = S & ":" Then
ProcNum = I
ProcPos = j
Exit Sub
End If
Next
Next
MsgBox "Метка " & S & " не существует", vbCritical, "Ошибка..."
End
End Sub
Sub RIPL_File_Delete(ByVal S As String)
S = Replace(S, Chr(34), "")
On Error Resume Next
SetAttr S, vbNormal
Err = 0
Kill S
If Err <> 0 Then MsgBox "Файл не может быть удалён. Ошибка: " & Err, vbCritical, "Ошибка..."
End Sub
Function RIPL_Trim(ByVal S As String) As String
RIPL_Trim = Trim(S)
End Function
Function RIPL_LCase(ByVal S As String) As String
RIPL_LCase = LCase(S)
End Function
Function RIPL_UCase(ByVal S As String) As String
RIPL_UCase = UCase(S)
End Function
Function RIPL_SC(ByVal S As String) As String
RIPL_SC = Asc(S)
End Function
Function RIPL_CS(ByVal S As String) As String
RIPL_CS = Chr(S)
End Function
Function RIPL_Length(ByVal S As String) As String
RIPL_Length = Len(S)
End Function
Function RIPL_Reverse(ByVal S As String) As String
RIPL_Reverse = StrReverse(S)
End Function
Sub RIPL_Output_TextColor(ByVal S As String)
ForeColor = CLng(S)
Output.InputTxt(0).ForeColor = CLng(S)
End Sub
Sub RIPL_Output_BackColor(ByVal S As String)
Output.BackColor = CLng(S)
Output.InputTxt(0).BackColor = CLng(S)
End Sub
Sub RIPL_Output_Show()
Output.Show
End Sub
Sub RIPL_Output_Hide()
Output.Hide
End Sub
Sub RIPL_Input(ByVal S As String)
Dim I As Integer
WaitForInput = True
Output.InputTxt(0).Top = (Output.OutputLbl.Count - 2) * 200
Output.InputTxt(0).Left = Output.OutputLbl(Output.OutputLbl.Count - 1).Width + 50
Output.InputTxt(0).Text = ""
Output.InputTxt(0).Visible = True
Output.InputTxt(0).SetFocus
Do While WaitForInput
DoEvents
Loop
Output.OutputLbl(Output.OutputLbl.Count - 1).Caption = Output.OutputLbl(Output.OutputLbl.Count - 1).Caption + " " + Output.InputTxt(0).Text
Output.InputTxt(0).Visible = False
For I = 1 To P.VarsCount
If P.Var(I).VarName = S Then
Select Case P.Var(I).VarType
Case 255: P.Var(I).VarValue = CVar(Output.InputTxt(0).Text)
Case 254: P.Var(I).VarValue = CStr(Output.InputTxt(0).Text)
Case 253: P.Var(I).VarValue = CDate(Output.InputTxt(0).Text)
Case 252: P.Var(I).VarValue = CDbl(Output.InputTxt(0).Text)
Case 251: P.Var(I).VarValue = CLng(Output.InputTxt(0).Text)
Case 250: P.Var(I).VarValue = CByte(Output.InputTxt(0).Text)
Case 249: P.Var(I).VarValue = CBool(Output.InputTxt(0).Text)
'Case Else: P.Var(i) = Right(S, Len(S) - I)
End Select
P.Var(I).VarValue = Output.InputTxt(0).Text
Exit Sub
End If
Next
MsgBox "Переменная " & S & " не продиклорирована!", vbCritical, "Ошибка..."
End
End Sub
И так далее. Это уже зависит от ваших фантазий. Исходный код приведён не полностью, но думаю, что даже эта часть даёт 100% представление о том, как можно реализовать компилирование (хотя и нестандартное). Думаю то, как реализовать рекодируемость вы догадаетесь сами. Если возникнут вопросы, то можете посылать их на: yxine@mail.ru
Примеры программ на языке RIPL
Первая программа в откомпилированном виде сможет быть запущена 10 раз. Уверен, что на любом другом языке это написать намного сложнее.
Program RIPL1
Var
Byte d=0
Rav
proc main
if d=10
end
else
ripl.code.delete 3
ripl.code.insert 3 “byte d=”+d+1
ripl.exe.save
fi
corp
В этом примере реализуем рекурсивную функцию вычисления факториала
Program RIPL2
Proc long factorial
Params
Byte n
smarap
If n=0
Ret 1
Else
Ret n*factorial(n-1)
End if
Corp
Proc main
? factorial(5)
end proc
Работа с типами
Program RIPL3
Type human
Byte age,height,mass
String F,I,O
Epyt
Var
Human me=20,184,65,”Larin”,”Alexsandr”,”Alexsandrovich”
Rav
Proc main
? “мне ”+me.age+” лет!”
Corp
Программа для угадывания числа. Запоминает предыдущие попытки пользователя и в следующий раз не загадывает числа, которые вводил пользователь при отгадывании
Program Guess
Var
Boolean user_number(1...10)=(false,false,false,false,false,false,false,false,false,false)
Integer number,computer_number,i
String tmp
Rav
Proc main
For each i in user_number
If i=false
Computer_number=@i
Jump play
Fi
Next
Ripl.code.delete 3
Ripl.code.insert 3 “boolean user_number(1...10)=(false, false, false, false, false, _
false, false, false, false ,false)”
ripl.exe.save
ripl.code.jump 1
Play:
Input Number
Ripl.repeat 16
Tmp=part(ripl.code.line(3),1,29)
For i,1,number-1,1
Tmp=tmp+”false,”
Next
Tmp=tmp+”true”
For i,number+1,10,1
Ripl.code.repeat 25
Next
Tmp=part(tmp,1,len(tmp)-1)+”)”
Ripl.code.insert 3 tmp
Ripl.exe.save
If number=computer_number
? “вы угадали”
else
? “вы не угадали”
fi
corp
Успехов!