• Курсы Академии Кодебай, стартующие в мае - июне, от команды The Codeby

    1. Цифровая криминалистика и реагирование на инциденты
    2. ОС Linux (DFIR) Старт: 16 мая
    3. Анализ фишинговых атак Старт: 16 мая Устройства для тестирования на проникновение Старт: 16 мая

    Скидки до 10%

    Полный список ближайших курсов ...

Помогите доделать код!

  • Автор темы koyan
  • Дата начала
Статус
Закрыто для дальнейших ответов.
K

koyan

Din исходный код программки, как сделать чтоб вопросы на которые отвечал юзер, копировались в файл вместе с ответами?

Private Sub BeginTest()
Dim I As Integer, t%, temp$
On Local Error GoTo Bug
TaskNum = 1
If Not IsAdmin Then
TestSize% = ReadINI("Default", "TestSize")
ReDim TaskOrder(1 To TestSize)
' определяем последовательность заданий
For I = 1 To DataBases.rsTask.RecordCount
temp = temp & Chr(I)
Next
For I = 1 To TestSize
DoEvents
Randomize
t = (Len(temp) - 1) * Rnd + 1
TaskOrder(I) = Asc(Mid(temp, t, 1))
temp = Left(temp, t - 1) & Right(temp, Len(temp) - t)
Next
Timer1.Enabled = True
Else
TestSize = DataBases.rsTask.RecordCount
ReDim TaskOrder(1 To TestSize)
For I = 1 To TestSize
TaskOrder(I) = I
Next
End If
isBoolResult = ReadINI("Default", "isBoolResult")
Mistakes = ReadINI("Default", "Mistakes")
Timeout = Val(ReadINI("General", "Timeout"))
Call NextTask(1)

Exit Sub
Bug:

End Sub

Private Sub NextTask(Optional Number As Integer)
Dim I%, objList As Object

With DataBases.rsTask
If Number = 0 Then
TaskNum = TaskNum + 1
Else
TaskNum = Number
End If
If TaskNum > TestSize Then
If IsAdmin = False Then
Call Finish
Else
NextTask (1)
End If
Exit Sub
End If
.MoveFirst
.Move (TaskOrder(TaskNum) - 1)
End With

I = 1
Dim Cname$, tstr$

Do While I <= 4
For Each objList In Me.Controls
Cname = objList.Name
' Debug.Print Cname
If Cname Like ("Check" & I) Then
' Debug.Print Cname
objList.Visible = True
If Not DataBases.rsTask.Fields(I + 1) = Empty Then
objList.Caption = DataBases.rsTask.Fields(I + 1)
Else
objList.Caption = ""
If Not IsAdmin Then: objList.Visible = False
End If
I = I + 1
End If
Next
Loop
lblQuestion.Caption = DataBases.rsTask.Fields(1)
Frame1.Caption = "Задание № " & TaskNum
RA = CStr(DataBases.rsTask.Fields(6))
If IsAdmin And (RA Like "*1*") Then
Check1.value = vbChecked
Else
Check1.value = vbUnchecked
End If
If IsAdmin And (RA Like "*2*") Then
Check2.value = vbChecked
Else
Check2.value = vbUnchecked
End If
If IsAdmin And (RA Like "*3*") Then
Check3.value = vbChecked
Else
Check3.value = vbUnchecked
End If
If IsAdmin And (RA Like "*4*") Then
Check4.value = vbChecked
Else
Check4.value = vbUnchecked
End If
End Sub

Private Sub imApply_Click()
Dim temp$
If Not IsAdmin Then
'IsAdmin = True
If Check1.value Then: temp = temp & 1
If Check2.value Then: temp = temp & 2
If Check3.value Then: temp = temp & 3
If Check4.value Then: temp = temp & 4
If temp = "" Or temp = "1234" Then
Call MsgBox("Выберите от 1 до 3" & vbNewLine & "вариантов ответа", vbCritical, "Внимание!")
Exit Sub
ElseIf Sort(RA) = temp Then
TaskOrder(TaskNum) = 1
Else
TaskOrder(TaskNum) = 0
End If
Else
RA = IIf(Check1.value, 1, "")
RA = RA & IIf(Check2.value, 2, "")
RA = RA & IIf(Check3.value, 3, "")
RA = RA & IIf(Check4.value, 4, "")
If RA = "" Or RA = "1234" Then
Call MsgBox("Выберите от 1 до 3" & vbNewLine & "вариантов ответа", vbCritical, "Внимание!")
Exit Sub
End If

With DataBases.rsCards
.Fields("Question") = Question
.Fields("AnswerText1") = Check1.Caption
.Fields("AnswerText2") = Check2.Caption
.Fields("AnswerText3") = Check3.Caption
.Fields("AnswerText4") = Check4.Caption
.Fields("RA") = RA
.Fields("Path") = Path
.Update
End With
End If
Call NextTask
End Sub
 
G

Gamlet

Устрой массивами. Один массив вопросов, другой -ответов. И пусть записываются почередно. :D
 
Статус
Закрыто для дальнейших ответов.
Мы в соцсетях:

Обучение наступательной кибербезопасности в игровой форме. Начать игру!