vbscript 检测瘦客户端验证期间是否需要OLL。在6.1.0.10之前的KTM环境中是必需的

Posted 2021-05-22

' Class Level Routines

Private Sub OLL_AutomaticLearning(ByVal pxdoc As CASCADELib.CscXDocument)
   On Error GoTo ErrorHandler
   OutputDebugString "KfxKTM_OLL_AutomaticLearning: Start"

   Dim i As Integer
   Dim asFieldList() As String
   Dim bDocTrainingNeeded As Boolean

   bDocTrainingNeeded = False

   ' First, is automatic learning enabled for the project?
   If Project.OLAutomaticTrainingEnabled  = False Then
      OutputDebugString "KfxKTM_OLL_AutomaticLearning: Automatic Learning Disabled; exiting"
      Exit Sub
   End If
   OutputDebugString "KfxKTM_OLL_AutomaticLearning: Automatic Learning Enabled"

   ' Get the list of fields that are monitored for automatic OLL
   OutputDebugString "KfxKTM_OLL_AutomaticLearning: Getting Field List"
   asFieldList() = OLL_GetMonitoredFields(pxdoc)

   ' Loop through each field and determine if field training is needed. If so, set document xValue
   OutputDebugString "KfxKTM_OLL_AutomaticLearning: Looping fields, checking if fields require training"
   For i = 0 To UBound(asFieldList)
      If OLL_IsFieldTrainingNeeded(pxdoc, asFieldList(i)) = True Then
         OutputDebugString "KfxKTM_OLL_AutomaticLearning: Training needed for field=" & CStr(asFieldList(i))
         bDocTrainingNeeded = True
      End If
   Next

   ' Determine how many fields require training and determine if to trigger OLL file creation
   If bDocTrainingNeeded = True Then
      OLL_WriteFile(pxdoc, CStr(pxdoc.CDoc.Pages(0).SourceFileName))
   End If


   OutputDebugString "KfxKTM_OLL_AutomaticLearning: Finish"
Exit Sub
ErrorHandler:
   General_Error_Handler("OLL_AutomaticLearning", LOG_ERROR, DISPLAY_TO_USER)
End Sub

Private Function OLL_GetMonitoredFields(ByVal pxdoc As CASCADELib.CscXDocument) As String()
   On Error GoTo ErrorHandler
   OutputDebugString "KfxKTM_OLL_GetMonitoredFields: Start"

   Dim i As Integer
   Dim sFieldList As String, asFieldList() As String

   ' Which fields are monitored for learning
   OutputDebugString "KfxKTM_OLL_GetMonitoredFields: Looping class " & CStr(BASE_CLASS) & " looking for fields set for automatic learning..."
   For i = 0 To Project.ClassByName(BASE_CLASS).Fields.Count - 1
      If Project.ClassByName(BASE_CLASS).Fields.ItemByIndex(i).AutomaticTraining = True Then
         sFieldList = sFieldList & IIf(sFieldList = "",Project.ClassByName(BASE_CLASS).Fields.ItemByIndex(i).Name,"|" & Project.ClassByName(BASE_CLASS).Fields.ItemByIndex(i).Name)
      End If
   Next
   OutputDebugString "KfxKTM_OLL_GetMonitoredFields: Monitored Fields=" & CStr(sFieldList)
   OLL_GetMonitoredFields = Split(sFieldList, "|")
   OutputDebugString "KfxKTM_OLL_GetMonitoredFields: Finish"

Exit Function
ErrorHandler:
   General_Error_Handler("OLL_GetMonitoredFields", LOG_ERROR, DISPLAY_TO_USER)
End Function

Private Function OLL_IsFieldTrainingNeeded(ByVal pxdoc As CASCADELib.CscXDocument, sFieldName As String) As Boolean
   On Error GoTo ErrorHandler
   OutputDebugString "KfxKTM_OLL_IsFieldTrainingNeeded: Start"
   OutputDebugString "KfxKTM_OLL_IsFieldTrainingNeeded: Checking Field=" & CStr(sFieldName)
   OLL_IsFieldTrainingNeeded = False

   Dim oField As CscXDocField
   Set oField = pxdoc.Fields.ItemByName(sFieldName)

   ' If the Top and Left positions have changed, assume field training is needed
   If oField.OriginalTop <> oField.Top And oField.OriginalLeft <> oField.Left Then
      OutputDebugString "KfxKTM_OLL_IsFieldTrainingNeeded: OriginalTop=" & CStr(oField.OriginalTop) & "/" & "ValidatedTop=" & CStr(oField.Top)
      OutputDebugString "KfxKTM_OLL_IsFieldTrainingNeeded: OriginalLeft=" & CStr(oField.OriginalLeft) & "/" & "ValidatedLeft=" & CStr(oField.Left)
      SetDocXValue(pxdoc, "OLL_TrainingNeeded_" & CStr(sFieldName), "True")
      OLL_IsFieldTrainingNeeded = True
      Else
         OutputDebugString "KfxKTM_OLL_IsFieldTrainingNeeded: Training not required for field"
   End If

   OutputDebugString "KfxKTM_OLL_IsFieldTrainingNeeded: Finish"
Exit Function
ErrorHandler:
   General_Error_Handler("OLL_IsFieldTrainingNeeded", LOG_ERROR, DISPLAY_TO_USER)
End Function

Private Sub OLL_WriteFile(ByVal pxdoc As CASCADELib.CscXDocument, sFullPath As String)
   Dim sBaseFolderPath As String
   Dim sBaseFileName As String
   Dim sOllFullPath As String
   Dim sOperatorUserID As String
   Dim FSO As Object
   Dim iFreeFile As Integer

   OutputDebugString "KfxKTM_OLL_WriteFile: Start"

   On Error Resume Next

   OutputDebugString "KfxKTM_OLL_WriteFile: Start"
   OutputDebugString "KfxKTM_SourceFileName=" & CStr(sFullPath)
   OutputDebugString "KfxKTM_SourceFileName=" & CStr(sFullPath)


   Set FSO = CreateObject("Scripting.FileSystemObject")

   sBaseFolderPath   = FSO.GetParentFolderName(sFullPath)
   sBaseFileName     = FSO.GetBaseName(sFullPath)
   'sBaseFilePath = Left(sDocumentPath, InStrRev(sDocumentPath, "\"))
   sOllFullPath = FSO.BuildPath(sBaseFolderPath, sBaseFileName) & ".oll"

   Select Case Project.ScriptExecutionMode
      Case CscScriptModeServer, CscScriptModeValidation
            sOperatorUserID = pxdoc.ParentFolder.XValues.ItemByName("AC_BATCH_OPERATORUSERID").Value
      Case CscScriptModeServerDesign, CscScriptModeValidationDesign
            sOperatorUserID = "Project Builder"
   End Select

   OutputDebugString "KfxKTM_FolderPath=" & CStr(sBaseFolderPath)
   OutputDebugString "KfxKTM_FileName=" & CStr(sBaseFileName)
   OutputDebugString "KfxKTM_OllFullPath=" & CStr(sOllFullPath)
   OutputDebugString "KfxKTM_OperatorUserID=" & CStr(sOperatorUserID)


   OutputDebugString "KfxKTM_Checking if Oll file already exists..."
   If FSO.FileExists(sOllFullPath) = True Then
      OutputDebugString "KfxKTM_Oll File exists, Deleting..."
      FSO.DeleteFile(sOllFullPath, True)
      OutputDebugString "KfxKTM_Oll File deleted, Checking..."
      If FSO.FileExists(sOllFullPath) = True Then
         OutputDebugString "KfxKTM_Could not delete, aborting OLL creation"
         Exit Sub
      End If
      OutputDebugString "KfxKTM_Delete Confirmed"
   End If

   iFreeFile = FreeFile
   Open sOllFullPath For Append As #iFreeFile
   OutputDebugString "KfxKTM_Opened File for append"
   OutputDebugString "KfxKTM_Writing Oll values"

   Print #iFreeFile, "NTUser=" & CStr(sOperatorUserID)
   Print #iFreeFile, "NTStation=" & CStr((Environ("COMPUTERNAME")))
   Print #iFreeFile, "Classification=0"
   Print #iFreeFile, "Extraction=0"
   Print #iFreeFile, "Specific=1"
   Print #iFreeFile, "Comment="

   Close #iFreeFile
   OutputDebugString "KfxKTM_Closed file"
   OutputDebugString "KfxKTM_OLL_WriteFile: Finish"

End Sub


Private Sub OLL_LogMonitoredFieldData(ByVal pxdoc As CASCADELib.CscXDocument, sFieldName As String)
   On Error GoTo ErrorHandler
   OutputDebugString "KfxKTM_OLL_LogMonitoredFieldData: Start"

   Dim oField As CscXDocField

   If Project.ClassByName(BASE_CLASS).Fields.ItemByName(sFieldName).AutomaticTraining = True Then
      Set oField = pxdoc.Fields.ItemByName(sFieldName)
      OutputDebugString "KfxKTM_OLL_LogMonitoredFieldData: Field=" & CStr(oField.Name)
      OutputDebugString "KfxKTM_OLL_LogMonitoredFieldData: OriginalHeight=" & CStr(oField.OriginalHeight)
      OutputDebugString "KfxKTM_OLL_LogMonitoredFieldData: OriginalLeft=" & CStr(oField.OriginalLeft)
      OutputDebugString "KfxKTM_OLL_LogMonitoredFieldData: OriginalPageIndex=" & CStr(oField.OriginalPageIndex)
      OutputDebugString "KfxKTM_OLL_LogMonitoredFieldData: OriginalText=" & CStr(oField.OriginalText)
      OutputDebugString "KfxKTM_OLL_LogMonitoredFieldData: OriginalTop=" & CStr(oField.OriginalTop)
      OutputDebugString "KfxKTM_OLL_LogMonitoredFieldData: OriginalValid=" & CStr(oField.OriginalValid)
      OutputDebugString "KfxKTM_OLL_LogMonitoredFieldData: OriginalVerified=" & CStr(oField.OriginalVerified)
      OutputDebugString "KfxKTM_OLL_LogMonitoredFieldData: OriginalWidth=" & CStr(oField.OriginalWidth)
   End If

   OutputDebugString "KfxKTM_OLL_LogMonitoredFieldData: Finish"
Exit Sub
ErrorHandler:
   General_Error_Handler("OLL_LogMonitoredFieldData", LOG_ERROR, DISPLAY_TO_USER)
End Sub






' Document Validated entry...

   ' Execute automatic onlinelearning check
   ' Only if running in the thin client
   'If Project.ScriptExecutionMode = CscScriptModeValidation And Project.ScriptExecutionModuleType = CscScriptModuleTypeRichClient Then
   'If Project.ScriptExecutionMode = CscScriptModeValidationDesign Then
   If Project.ScriptExecutionMode = CscScriptModeValidation And Project.ScriptExecutionModuleType = CscScriptModuleTypeThinClient Then
      OutputDebugString "KfxKTM_Thin Client Detected, trigger Automatic Learning check"
      OLL_AutomaticLearning(pxdoc)
   End If
   
  
  
  
  
   
' After Field Confirmed entry....

   ' Attempt to Log monitored field data for fields where OLL monitoring is enabled.
   OLL_LogMonitoredFieldData(pxdoc, pField.Name)







' Document Loaded entry...

   ' Log OLL Monitored Field Data
   Dim j As Integer
   Dim sFieldList As String, asFieldList() As String
   asFieldList() = OLL_GetMonitoredFields(pxdoc)
   For j = 0 To UBound(asFieldList)
      OLL_LogMonitoredFieldData(pxdoc, asFieldList(j))
   Next