Environment/ServerMod.bas at main · M2000Interpreter/Environment · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
Attribute VB_Name = "ServerMod"
Public Function CallEventFromSocketNow(sck As Server, a As mEvent, aString$, vrs()) As Boolean
Dim tr As Boolean, extr As Boolean, olescok As Boolean
olescok = escok
escok = False
CallEventFromSocketNow = True
extr = extreme
extreme = True
tr = trace
If Rnd * 100 > 3 Then trace = False
Dim n$, f$, F1$, bb As mStiva, oldbstack As mStiva, nowtotal As Long
Dim bstack As basetask
Set bstack = New basetask
Set bstack.Owner = Form1.DIS
Set bstack.StaticCollection = EventStaticCollection
bstack.IamAnEvent = True
Dim i As Long
If a Is Nothing Then GoTo conthere0
i = a.VarIndex
F1$ = sck.modulename
Set oldbstack = bstack.soros
Dim j As Long, k As Long, s1$, klm As Long, s2$
Dim ohere$
ohere$ = here$
here$ = "EV" + CStr(i)
If a.enabled Then
    a.ReadVar 0, n$, f$
    If f$ <> "" Then
        Set bb = New mStiva
        Set bstack.Sorosref = bb
        PushStage bstack, False
            For k = LBound(vrs()) To UBound(vrs()) - 1
                If VarType(vrs(k)) = vbString Then
                    globalvarGroup "EV" + CStr(i + k) + "$", vrs(k)
                    bb.DataStr here$ + "." + "EV" + CStr(i + k) + "$"
                Else
                    globalvarGroup "EV" + CStr(i + k), vrs(k)
                    bb.DataStr here$ + "." + "EV" + CStr(i + k)
                End If
            Next k
            bb.DataObj sck
            FastPureLabel aString$, f$, , , , , False
            n$ = Mid$(aString$, Len(f$) + 1)
            If Len(n$) > 0 Then
                n$ = Left$(n$, Len(n$) - 1)
                If n$ <> "" Then n$ = "Push " + n$ + vbCrLf
            End If
            If F1$ <> "" Then f$ = myUcase(F1$ + "." + f$ + ")", True) Else f$ = myUcase(f$ + ")", True)
            If Not GetSub(f$, klm) Then PopStage bstack: bb.Flush: CallEventFromSocketNow = False: GoTo conthere
            s1$ = sbf(klm).sb
            If Left$(s1$, 10) = "'11001EDIT" Then
                SetNextLine s1$
            End If
            If F1$ <> "" Then s1$ = n$ + "Module " + F1$ + vbCrLf + sbf(klm).sb Else s1$ = n$ + sbf(klm).sb
            Dim nn As Long

            If Execute(bstack, s1$, False, False) = 0 Then
                MyEr "Problem in Event " + aString$, "Ðñüâëçìá óôï ãåãïíüò " + aString$
                PopStage bstack
                bb.Flush
                GoTo conthere
            End If
            here$ = "EV" + CStr(i)
            For k = LBound(vrs()) To UBound(vrs()) - 1
                If VarType(vrs(k)) = vbString Then
                    GetlocalVar "EV" + CStr(i + k) + "$", j
                    vrs(k) = var(j)
                Else
                    GetlocalVar "EV" + CStr(i + k), j
                    vrs(k) = var(j)
                End If
            Next k
            PopStage bstack
            bb.Flush
        End If
    End If
conthere:
    Set bstack.Sorosref = oldbstack
    here$ = ohere$
conthere0:
    Set oldbstack = Nothing
    Set bb = Nothing
    If tr Then trace = tr
    extreme = extr
    escok = olescok
End Function
Public Function CallEventFromSocketOne(sck As Server, a As mEvent, aString$) As Boolean
Dim tr As Boolean, extr As Boolean, olescok As Boolean
CallEventFromSocketOne = True
olescok = escok
escok = False
tr = trace
extr = extreme
extreme = True
If Rnd * 100 > 3 Then trace = False
Dim n$, f$, F1$, bb As mStiva, uIndex As Long
Dim bstack As basetask
Set bstack = New basetask
Set bstack.Owner = Form1.DIS
Set bstack.StaticCollection = EventStaticCollection
bstack.IamAnEvent = True
Dim i As Long
If a Is Nothing Then GoTo conthere0
i = a.VarIndex
uIndex = sck.index
If uIndex >= 0 Then
bstack.soros.DataVal CDbl(uIndex)
uIndex = 1
End If
uIndex = uIndex + 1
F1$ = sck.modulename
bstack.soros.DataObj sck

Dim j As Long, k As Long, s1$, klm As Long, s2$
Dim ohere$
ohere$ = here$
here$ = "EV" + CStr(i)
If a.enabled Then
            PushStage bstack, False
            FastPureLabel aString$, f$, , , , , False
            n$ = Mid$(aString$, Len(f$) + 1)
            n$ = Left$(n$, Len(n$) - 1)
            If n$ <> "" Then
           If uIndex > 0 Then
            n$ = "Data " + n$ + " : ShiftBack Stack.Size" + Str(1 - uIndex) + "," + Str$(uIndex) + vbCrLf
            Else
            n$ = "Data " + n$ + " : ShiftBack Stack.Size" + vbCrLf
            End If
            End If
            If F1$ <> "" Then f$ = myUcase(F1$ + "." + f$ + ")", True) Else f$ = myUcase(f$ + ")", True)
            If Not GetSub(f$, klm) Then
            PopStage bstack: CallEventFromSocketOne = False: GoTo conthere
            End If
            s1$ = sbf(klm).sb
            If Left$(s1$, 10) = "'11001EDIT" Then
            SetNextLine s1$
            End If
            If F1$ <> "" Then s1$ = n$ + "Module " + F1$ + vbCrLf + sbf(klm).sb Else s1$ = n$ + sbf(klm).sb
            If Execute(bstack, s1$, False, False) = 0 Then
            If F1$ = vbNullString Then
            MyEr "Problem in Event " + aString$, "Ðñüâëçìá óôï ãåãïíüò " + aString$
            Else
            MyEr "Problem in Event " + aString$ + " in module " + F1$, "Ðñüâëçìá óôï ãåãïíüò " + aString$ + " óôï ôìÞìá " + F1$
            End If
            bstack.soros.Flush
                PopStage bstack
                GoTo conthere
            End If
            PopStage bstack
End If
conthere:
Set bstack = Nothing
here$ = ohere$
conthere0:
If tr Then trace = tr
extreme = extr
escok = olescok
End Function