Познакомьтесь с пентестом веб-приложений на практике в нашем новом бесплатном курсе
Прошу уточнить
Тестировал Вашим же кодом.Код:'... bool = (s = "") '... bool = (Len(s) = 0) '...
length& = 1000
Dim lst List As String
For i& = 0 To length&
lst(i&) = Cstr(i&)
Next
startTime = Getthreadinfo(6)
For i& = 0 To length&
Print lst(i&)
Next
Print Format$((Getthreadinfo(6) - startTime) / Getthreadinfo(7), "##.00")
length& = 1000
Redim arr(length&) As String
For i& = 0 To length&
arr(i&) = Cstr(i&)
Next
startTime = Getthreadinfo(6)
For i& = 0 To length&
Print arr(i&)
Next
Print Format$((Getthreadinfo(6) - startTime) / Getthreadinfo(7), "##.00")
List 0.20
Array 0.22
Array 0.22
List 0.22
Array 0.23
List 0.27
List 0.23
Array 0.28
List 2.32
Array 2.09
length& = 5000
Dim lst List As String
For i& = 0 To length&
lst(i&) = Cstr(i&)
Next
startTime = Getthreadinfo(6)
i& = 0
Forall element In lst
Print lst(i&)
i& = i& + 1
End Forall
Print Format$((Getthreadinfo(6) - startTime) / Getthreadinfo(7), "##.00")
length& = 5000
Redim arr(length&) As String
For i& = 0 To length&
arr(i&) = Cstr(i&)
Next
startTime = Getthreadinfo(6)
i& = 0
Forall element In arr
Print arr(i&)
i& = i& + 1
End Forall
Print Format$((Getthreadinfo(6) - startTime) / Getthreadinfo(7), "##.00")
List 2.22
Array 2.23
List 0.22
Array 0.22
Поучается: массив и список наследники одного объекта в разных вариациях?данные из массива по индексу и данные из списка по хэшу вычитываются примерно одинаково
Sub Initialize
Dim result As String, counts As String
counts = {10000, 20000,30000,40000,50000,60000,70000,80000,90000,100000}
Dim arr
arr=Split(counts,{,})
For c&=0 To Ubound(arr)
length&=Clng(arr(c&))
Dim lst List As String
For i& = 0 To length&
lst(i&) = Cstr(i&)
Next
Dim startTime As Long, endTime As Long
startTime = Getthreadinfo(6)
Dim s As String
For i& = 0 To length&
' Print lst(i&)
'тупо копируем стринги
s={} &lst(i&)
Next
endTime=Getthreadinfo(6)
result=result &{cnt:} &arr(c&) & {;tics:} &Cstr(endTime- startTime) & Chr(10)
Next
Print result
Msgbox result
End Sub
Я понял, это была злая шутка :mellow:Код:Dim counts As String counts = {10000, 20000,30000,40000,50000,60000,70000,80000,90000,100000}
Option Public
Option Declare
Use "ErrorHandling"
Private Const ERR_BASE=1024
Const UNPROPER_CHAIN=ERR_BASE+1,CS_UNPROPER_CHAIN={Действие не соответствует типу в цепочке}
Const CS_ERR_UIDOC={не установлен объект NotesUIDocument}
Const CS_QUERYOPEN={QUERYOPEN}
Const CS_CALLER_SB={вызывающая ф-ция д.б.:}
Const ACT_TYPES={}
Private wks As NotesUIWorkspace
Private ses As NotesSession
Private source As NotesUIDocument
Private formObj As FormBase
Private gContinue As Boolean
%REM
Class FormBase
Description: InitObjectsUI нобходимо переопределить
%END REM
Private Class FormBase As ErrorHandler
Private actList List As ActionObject
%REM
Sub New
Description: Comments for Sub
%END REM
Sub New
End Sub
%REM
Function Regiter
Description: Comments for Function
%END REM
Function Register(act As ActionObject) As Boolean
On Error GoTo ErrH
If Not act Is Nothing Then
Dim s As String
s=act.Name
Dim obj As ActionObject
If Not IsElement(actList(s)) Then
Set actList(s)=act
Set obj=act
Else
Set obj=actList(s)
End If
Dim res As ActionObject
Set res=obj.ChainAction(act)
Call obj.Register()
End If
Quit:
Exit Function
ErrH:
Error ERR_BASE, RaiseError
Resume Quit
End Function
%REM
Sub InitObjectsUI
Description: ф-ция для примера, нужно переписывать для своей реализации
%END REM
Function InitObjectsUI(uidoc As NotesUIDocument, xMode As Integer, xIsnewdoc, Xcontinue)
On Error GoTo ErrH
'устанавливаем глобальную переменную (не д.б. Nothing)
Set source=uidoc
Dim act_QO As TemplQueryOpen, _
act_PO As TemplPostOpen, _
act_QS As TemplQuerySave
Set act_QO=New TemplQueryopen()
Set act_PO=New TemplPostOpen()
Set act_QS=New TemplQuerySave()
Call Me.Register(act_QO)
Call Me.Register(act_PO)
Dim tmp As New TemplQueryRecalc()
Call Me.Register(tmp)
Call Me.Register(act_QS)
Call act_QO.Action(uidoc, xMode, xIsnewdoc, Xcontinue)
Quit:
Exit Function
ErrH:
Error ERR_BASE, RaiseError
Resume Quit
End Function
End Class
%REM
Class ActionObject
Description: Comments for Class
%END REM
Class ActionObject As ErrorHandler
Private actName As String
Private actObj As Variant
Private actNext As ActionObject
Private isRegistred As Boolean
Sub New(obj, xName As String)
Me.actName=xName
Set Me.actObj=obj
End Sub
Public Property Get Name As String
Me.Name=actName
End Property
%REM
Property Get Object
Description: Comments for Property Get
%END REM
Public Property Get Object As Variant
Set Me.Object=actObj
End Property
%REM
Function ChainAction
Description: определяет цепочку обработки однотипных событий
%END REM
Public Function ChainAction(nxt As ActionObject) As ActionObject
If nxt Is actNext Or nxt Is Me Then Set ChainAction=actNext:Exit Function
If UCase(actName) <> nxt.Name Then Error UNPROPER_CHAIN,CS_UNPROPER_CHAIN
Set actNext=nxt
Set ChainAction=actNext
End Function
%REM
Sub Register
Description: Comments for Sub
%END REM
Sub Register
End Sub
End Class
%REM
Class FromAction
Description: Comments for Class
%END REM
Class FormAction As ActionObject
Sub New(uidoc As NotesUIDocument, xName As String), ActionObject(uidoc, xName)
If uidoc Is Nothing Then Error ERR_BASE, CS_ERR_UIDOC
Set source=uidoc
End Sub
End Class
%REM
Class ActionPostOpen
Description: Comments for Class
%END REM
Private Class TemplPostOpen As FormAction
Sub New(), FormAction(source, {PostOpen})
' Set source=uidoc
End Sub
Sub Action(uidoc As NotesUIDocument)
Print {Action:} &Me.actName
End Sub
Sub Register
On Error GoTo ErrH
If Not Me.IsRegistred Then
On Event PostOpen From source Call Action
Me.isRegistred=True
End If
Quit:
Exit Sub
ErrH:
Error ERR_BASE, RaiseError
Resume Quit
End Sub
End Class
Private Class TemplQueryopen As FormAction
Sub New(), FormAction(source, {Queryopen})
End Sub
Sub Action(uidoc As NotesUIDocument, xMode As Integer, xIsnewdoc, xContinue)
Print {Action:} &Me.actName
' xcontinue=False
End Sub
Sub Register
On Error GoTo ErrH
If Not Me.IsRegistred Then
On Event QueryOpen From source Call Action
Me.isRegistred=true
End If
Quit:
Exit Sub
ErrH:
Error ERR_BASE, RaiseError
Resume Quit
End Sub
End Class
%REM
Class QuerySave
Description: Comments for Class
%END REM
Private Class TemplQuerySave As FormAction
Sub New(), FormAction(source, {QuerySave})
End Sub
Sub Action(uidoc As NotesUIDocument, xContinue)
Print {Action:} &Me.actName
xContinue=False
End Sub
Sub Register
On Error GoTo ErrH
If Not Me.IsRegistred Then
On Event QuerySave From source Call Action
Me.isRegistred=True
End If
Quit:
Exit Sub
ErrH:
Error ERR_BASE, RaiseError
Resume Quit
End Sub
End Class
%REM
Class TemplQueryRecalc
Description: Comments for Class
%END REM
Private Class TemplQueryRecalc As FormAction
Sub New(), FormAction(source, {QueryRecalc})
End Sub
Sub Action(uidoc As NotesUIDocument, Continue)
Print {Action:} &Me.actName
Continue=False
End Sub
Sub Register
On Error GoTo ErrH
If Not Me.IsRegistred Then
On Event QueryRecalc From source Call Action
Me.isRegistred=True
End If
Quit:
Exit Sub
ErrH:
Error ERR_BASE, RaiseError
Resume Quit
End Sub
End Class
%REM
Class TemplPostSave
Description: Comments for Class
%END REM
Private Class TemplPostSave As FormAction
Sub New(), FormAction(source, {PostSave})
' Set source=uidoc
End Sub
Sub Action(uidoc As NotesUIDocument)
Print {Action:} &Me.actName
End Sub
Sub Register
On Error GoTo ErrH
If Not Me.IsRegistred Then
On Event PostSave From source Call Action
Me.isRegistred=True
End If
Quit:
Exit Sub
ErrH:
Error ERR_BASE, RaiseError
Resume Quit
End Sub
End Class
%REM
Class TemplPostRecalc
Description: Comments for Class
%END REM
Private Class TemplPostRecalc As FormAction
Sub New(), FormAction(source, {PostRecalc})
' Set source=uidoc
End Sub
Sub Action(uidoc As NotesUIDocument)
Print {Action:} &Me.actName
End Sub
Sub Register
On Error GoTo ErrH
If Not Me.IsRegistred Then
On Event PostRecalc From source Call Action
Me.isRegistred=True
End If
Quit:
Exit Sub
ErrH:
Error ERR_BASE, RaiseError
Resume Quit
End Sub
End Class
%REM
Class TemplQueryClose
Description: Comments for Class
%END REM
Private Class TemplQueryClose As FormAction
Sub New(), FormAction(source, {QueryClose})
End Sub
Sub Action(uidoc As NotesUIDocument, xContinue)
Print {Action:} &Me.actName
xContinue=False
End Sub
Sub Register
On Error GoTo ErrH
If Not Me.IsRegistred Then
On Event QueryClose From source Call Action
Me.isRegistred=True
End If
Quit:
Exit Sub
ErrH:
Error ERR_BASE, RaiseError
Resume Quit
End Sub
End Class
Sub Initialize
Set wks=New NotesUIWorkspace
Set ses=New NotesSession
Set formObj=New FormBase
gContinue=True
End Sub
%REM
Sub InitObjects
Description: Comments for Sub
%END REM
Sub InitObjects
On Error GoTo ErrH
Dim formObj As New FormBase
Dim act_QO As New TemplQueryopen()
Dim act_PO As New TemplPostOpen()
Call formObj.Register(act_QO)
Call formObj.Register(act_PO)
Quit:
Exit Sub
ErrH:
Error ERR_BASE, RaiseError()
Resume Quit
End Sub
%REM
Sub InitObjectsUI
Description: вызывать нужно из QueryOpen
%END REM
Sub InitObjectsUI(uidoc As NotesUIDocument, xMode As Integer, xIsnewdoc, Xcontinue)
On Error GoTo ErrH
If CStr(GetThreadInfo(LSI_THREAD_CALLPROC))<> CS_QUERYOPEN Then _
Error ERR_BASE, CS_CALLER_SB &CS_QUERYOPEN
If gContinue Then
Call formObj.InitObjectsUI(Uidoc, Xmode, Xisnewdoc, Xcontinue)
Else
xContinue=gcontinue
End if
Quit:
Exit Sub
ErrH:
gContinue=false
Error ERR_BASE, RaiseError()
Resume Quit
End Sub
Ну да, как -то подключение несуществующей библиотеки и ошибка в обработчике ошибок.и ваще - могут быть ошибки - я не гонял код и писал на коленке wink.gif
Option Public
Option Declare
%INCLUDE "lserr.lss"
'Uselsx "*lsxlc"
Uselsx "*javacon"
%INCLUDE "lsconst.lss"
Const ERR_FIELDFORMAT=1100
Const ERR_CHILDSOURCE=1200
Const MSG_FIELDFORMAT="индекс вне диапозона массива форматирования"
Const MSG_CHILSOURCE={элемент списка "0" д.б. равен имени view}
Dim debug As Boolean
Dim log2file As Boolean
Dim logStream As NotesStream
Private ses As NotesSession
Private db As NotesDatabase
Class ErrorHandler
Sub ClrError()
End Sub
Sub New()
Call Me.ClrError()
End Sub
Function GetModuleInfo() As String
Dim thisType As String, modInfo As String
thisType= Typename(Me)
' Not a class, use the calling module instead
If (thisType = "") Then thisType = Getthreadinfo(11)
modInfo = thisType & "::" & Getthreadinfo(10) & ": "
GetModuleInfo=modInfo
End Function
Function RaiseError() As String
Dim es As String
es=GetModuleInfo()
If (Err = 0) Then
es = es + "Manually raised an error"
Else
es = es + "err. (" + Trim(Str(Err)) + ") " + Error$ + " l. "+ Trim(Str(Erl))
End If
Print es
Me.RaiseError=es & Chr(10)
If (Not logStream Is Nothing) And log2file Then Call logStream.WriteText(es,EOL_PLATFORM)
Call Me.ClrError()
End Function
End Class
Class ErrorHandlerWJ As ErrorHandler
Private jSession As JavaSession
Private jError As JavaError
Sub New()
On Error Goto errorhandler
Set jSession= New JAVASESSION
ExitFunction:
Exit Sub
errorhandler:
Call ErrorHandler..RaiseError()
Resume ExitFunction
End Sub
Function RaiseError() As String
Set jError = jSession.getLastJavaError()
Dim es As String
If (jError.errorMsg = "") Then
es=ErrorHandler..RaiseError()
Else
es=GetModuleInfo()+"Error at line " & Erl & ": " & jError.errorMsg
Print es
jSession.ClearJavaError
End If
RaiseError=es
If (Not logStream Is Nothing) And log2file Then Call logStream.WriteText(es,EOL_PLATFORM)
End Function
End Class
Sub Initialize
debug=False
Set ses=New NotesSession
Set db=ses.CurrentDatabase
Set logStream=ses.CreateStream
Dim dt As New NotesDateTime({Today})
dt.SetNow
Dim fname As String
fname= {_} &Replace(Replace(Replace(dt.LocalTime,{:},{-}),{ },{_}),{.},{-}) &_
{#} &db.ReplicaID &_
{-} &Replace(Getthreadinfo(LSI_THREAD_CALLMODULE),{*},{}) &_
{.log}
If Not logStream.Open(fname,{UTF-8}) Then
' logStream=Nothing
End If
' Msgbox fname &Chr(10) &logStream.WriteText({*-------------start ------------*})
End Sub
Sub Terminate
' If Not logStream Is Nothing Then logStream.Close
End Sub
Function RaiseErrorMsg()
Dim thisType As String
Dim es As String
'thisType = Typename(Me)
' Not a class, use the calling module instead
If (thisType = "") Then thisType = Getthreadinfo(11)
es = thisType & "::" & Getthreadinfo(10) & ": "
If (Err = 0) Then
es = es + "Manually raised an error"
Else
es = es + "Run time error: (" + Trim(Str(Err)) + ") " + Error$ + " at line: "+ Trim(Str(Erl))
End If
Msgbox es
End Function
Sub DbgMsg(txt As String)
If (debug) Then Print txt
End Sub
Sub Alert(s As String)
Messagebox s, MB_OK+MB_ICONSTOP
End Sub
Function RaiseError() As String
Dim thisType As String
Dim es As String
'thisType = Typename(Me)
' Not a class, use the calling module instead
If (thisType = "") Then thisType = Getthreadinfo(11)
es = thisType & "::" & Getthreadinfo(10) & ": "
If (Err = 0) Then
es = es + "Manually raised an error"
Else
es = es + "err. (" + Trim(Str(Err)) + ") " + Error$ + " l."+ Trim(Str(Erl))
End If
Print es
RaiseError=es + Chr(10)
If (Not logStream Is Nothing) And log2file Then Call logStream.WriteText(es,EOL_PLATFORM)
End Function
Function LogMsg(curLine As Long, msg As String)
If (Not logStream Is Nothing) And log2file Then Call logStream.WriteText({#} &Format(Cstr(curLine), {000000}) &{:} &msg,EOL_PLATFORM)
End Function
Получается для каждой системы такая либа будет уникальна...смысл либы - писать объекты экшенов на соответ события и регать их в объекте формы
для каждой формыПолучается для каждой системы такая либа будет уникальна...
вот этого и не нужно..., заполняется только QOчтобы заполнить события формы вызовами из либы
Обучение наступательной кибербезопасности в игровой форме. Начать игру!