home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual BASIC 5.0 (Ent. Edition) / Vb5ent Extractor.EXE / VB / SAMPLES / ENTRPRIS / APE / AESERVIC / SERVICE.CLS < prev   
Encoding:
Visual Basic class definition  |  1996-12-04  |  8.3 KB  |  205 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "Service"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. Attribute VB_Description = "Provides an interface for AEWorker.Worker objects to call, to execute realistic examples of server side processing."
  11. Option Explicit
  12.  
  13. Implements APEInterfaces.Service
  14.  
  15. Private mwsService As Workspace
  16. Private mdbService As Database
  17. Private mbDBCreated As Boolean
  18.  
  19. Public Sub Execute(ByRef sCommand As String, Optional ByRef vServiceData As Variant, Optional ByRef vReturn As Variant)
  20. Attribute Execute.VB_Description = "AEWorker.Worker objects call this method when using late binding."
  21.     '-------------------------------------------------------------------------
  22.     'Purpose:
  23.     '   Provides an interface for late binding.  Late binding is only provide
  24.     '   for test comparison.  Other custom services should only use the implemented
  25.     '   interface.
  26.     '-------------------------------------------------------------------------
  27.     Dim bSecondMissing As Boolean
  28.     Dim bThirdMissing As Boolean
  29.     bSecondMissing = IsMissing(vServiceData)
  30.     bThirdMissing = IsMissing(vReturn)
  31.     If bSecondMissing And bThirdMissing Then
  32.         Service_Execute sCommand
  33.     ElseIf bThirdMissing Then
  34.         Service_Execute sCommand, vServiceData
  35.     ElseIf bSecondMissing Then
  36.         Service_Execute sCommand, , vReturn
  37.     Else
  38.         Service_Execute sCommand, vServiceData, vReturn
  39.     End If
  40. End Sub
  41.  
  42. Private Sub Service_Execute(sCommand As String, Optional vServiceData As Variant, Optional vReturn As Variant)
  43.     '-------------------------------------------------------------------------
  44.     'Purpose:
  45.     '   In response to the data it receives, it may return data of different
  46.     '   sizes are types and/or sleep or burn processor cycles for a certain
  47.     '   amount of time.
  48.     'In:
  49.     '   [sCommand]
  50.     '       A string the represents what this procedure should do.  It is intended
  51.     '       be used to case and call an appropriate procedure in response if this
  52.     '       was a real solution service provider.  This object expects either
  53.     '       "UseProcessor" or "DontUserProcessor".
  54.     '   [vServiceData]
  55.     '       This object expects a variant array or variant collection in which
  56.     '       the elements of the array or collection specify how much data to
  57.     '       return, what type of data to return, and how long to wait before
  58.     '       releasing the calling worker.
  59.     'Out:
  60.     '   [vReturn]
  61.     '       This could be a variant array or collection of any specified size
  62.     '       it will be returned by the calling worker to the client or the
  63.     '       expediter
  64.     '-------------------------------------------------------------------------
  65.     'sCommand   What to do.  Ex: "Method"
  66.     'vServiceData      The data needed to carrry out sCommand.
  67.     Dim iLensCommand As Integer
  68.     Dim iChar As Integer
  69.     Dim iLastChar As Integer
  70.     Dim lEndTicks As Long
  71.     Dim lRecordNumRows As Long
  72.     Dim lRecordRowSize As Long
  73.     Dim lRecordMilliseconds As Long
  74.     Dim lRecordContainerType As Long
  75.     Dim rsService As Recordset
  76.     
  77.     Dim s As String
  78.     Dim i As Integer
  79.     Dim v() As Variant
  80.     
  81.     On Error GoTo Service_ExecuteError
  82.     If Not IsMissing(vServiceData) Then
  83.         'Are we using a Varriant Array or Collection?
  84.         If VarType(vServiceData) = (vbArray + vbVariant) Then
  85.             'It's an array
  86.             lRecordNumRows = vServiceData(giRECORD_NUMROWS)
  87.             lRecordRowSize = vServiceData(giRECORD_ROWSIZE)
  88.             lRecordMilliseconds = vServiceData(giRECORD_MILLISECONDS)
  89.             lRecordContainerType = vServiceData(giRECORD_CONTAINER_TYPE)
  90.         Else
  91.             'It's a collection
  92.             lRecordNumRows = vServiceData.Item(CStr(giRECORD_NUMROWS))
  93.             lRecordRowSize = vServiceData.Item(CStr(giRECORD_ROWSIZE))
  94.             lRecordMilliseconds = vServiceData.Item(CStr(giRECORD_MILLISECONDS))
  95.             lRecordContainerType = vServiceData.Item(CStr(giRECORD_CONTAINER_TYPE))
  96.         End If
  97.         'Do we need to do anything?
  98.         If lRecordMilliseconds < 0 Or lRecordMilliseconds > glMAX_DURATION Then Err.Raise giBAD_DURATION
  99.     End If
  100.     
  101.     Select Case sCommand
  102.         Case gsSERVICE_USE_PROCESSOR
  103.             If lRecordMilliseconds > 0 Then
  104.                 lEndTicks = GetTickCount() + lRecordMilliseconds
  105.                 Do While lEndTicks > GetTickCount()
  106.                     'Using Cycles
  107.                 Loop
  108.             End If
  109.         Case gsSERVICE_DONT_USE_PROCESSOR
  110.             If lRecordMilliseconds > 0 Then
  111.                 Sleep lRecordMilliseconds
  112.             End If
  113.         Case gsSERVICE_READ_DATA
  114.             If Not mbDBCreated Then CreateDBObject
  115.             Set rsService = mdbService.OpenRecordset(gsREAD_QUERY, dbOpenDynaset)
  116.             rsService.FindFirst gsFIND_CRITERIA
  117.             s = rsService.Fields(gsFIELD_TO_READ).Value
  118.             Set rsService = Nothing
  119.         Case gsSERVICE_WRITE_DATA
  120.             If Not mbDBCreated Then CreateDBObject
  121.             mdbService.Execute gsWRITE_QUERY
  122.         Case gsSERVICE_READWRITE_DATA
  123.             If Not mbDBCreated Then CreateDBObject
  124.             mdbService.Execute gsWRITE_QUERY
  125.             
  126.             Set rsService = mdbService.OpenRecordset(gsREAD_QUERY, dbOpenDynaset)
  127.             rsService.FindFirst gsFIND_CRITERIA
  128.             s = rsService.Fields(gsFIELD_TO_READ).Value
  129.             Set rsService = Nothing
  130.     End Select
  131.     
  132.     If (Not IsMissing(vReturn)) And lRecordContainerType <> giCONTAINER_TYPE_NULL And lRecordNumRows <> 0 And lRecordRowSize <> 0 Then
  133.         'Return something
  134.         Select Case lRecordContainerType
  135.             Case giCONTAINER_TYPE_VARRAY
  136.                 s = Space(lRecordRowSize)
  137.                 ReDim v(lRecordNumRows - 1) As Variant
  138.                 For i = 0 To lRecordNumRows - 1
  139.                     v(i) = s
  140.                 Next i
  141.                 vReturn = v
  142.             Case giCONTAINER_TYPE_VCOLLECTION
  143.                 Set vReturn = New Collection
  144.                 s = Space(lRecordRowSize)
  145.                 For i = 1 To lRecordNumRows
  146.                     vReturn.Add s
  147.                 Next i
  148.             Case giCONTAINER_TYPE_RECORDSET
  149.                 'Not yet implemented
  150.                  Set vReturn = Nothing
  151.             Case Else
  152.                 'Some unknown ContainterTypeValue
  153.                 Err.Raise giBAD_DATA_TYPE
  154.          End Select
  155.     End If
  156.     
  157.     Exit Sub
  158. Service_ExecuteError:
  159.     Select Case Err.Number
  160.         Case ERR_TYPE_MISMATCH, ERR_OVER_FLOW
  161.             'vServiceData contained a bad data type.  Raise an appliction defined error.
  162.             Err.Raise giBAD_DATA, Err.Source, LoadResString(giBAD_DATA)
  163.         Case giBAD_DURATION
  164.             'They wanted to sleep more than glMAX_DURATION
  165.             Err.Raise Err.Number, Err.Source, ReplaceString(LoadResString(giBAD_DURATION), gsNUMBER_TOKEN, CStr(glMAX_DURATION))
  166.         Case Is > giERROR_THRESHOLD
  167.             'Application defined error.  Since this is the only public method
  168.             'all errors raised there will be returned to the calling program.
  169.             Err.Raise Err.Number + vbObjectError, Err.Source, Err.Description
  170.         Case Else
  171.             'VB error
  172.             Err.Raise Err.Number, Err.Source, Err.Description
  173.     End Select
  174.  
  175. End Sub
  176.  
  177. Private Sub Class_Initialize()
  178.     On Error Resume Next
  179.     CreateDBObject
  180. End Sub
  181.  
  182. Private Sub CreateDBObject()
  183.     Dim sPath As String
  184.     sPath = FormatPath(App.Path) & gsDBName
  185.     'Make sure DB file is not readonly
  186.     SetAttr sPath, vbNormal
  187.     SetAttr sPath, vbArchive
  188.     Set mwsService = DBEngine.Workspaces(0) 'Default Workspace
  189.     Set mdbService = OpenDatabase(sPath)
  190.     mbDBCreated = True
  191. End Sub
  192.  
  193. Private Function FormatPath(sPath As String) As String
  194.     '-------------------------------------------------------------------------
  195.     'Purpose:   Make sure that the passed path has a "\" at the end of it
  196.     'IN:
  197.     '   [sPath] File name to check
  198.     'Return:    File name with a "\" at the end of it
  199.     '-------------------------------------------------------------------------
  200.     If Not Right$(sPath, 1) = "\" Then sPath = sPath & "\"
  201.     FormatPath = sPath
  202.         
  203. End Function
  204.  
  205.