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 / CALLBACK / CLBK_CLI.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-12-03  |  10.4 KB  |  297 lines
  1. VERSION 5.00
  2. Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.1#0"; "comctl32.ocx"
  3. Begin VB.Form frmCBCli 
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "Callback Clock Client"
  6.    ClientHeight    =   2205
  7.    ClientLeft      =   2880
  8.    ClientTop       =   2610
  9.    ClientWidth     =   5370
  10.    ClipControls    =   0   'False
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    PaletteMode     =   1  'UseZOrder
  15.    ScaleHeight     =   2205
  16.    ScaleWidth      =   5370
  17.    Begin ComctlLib.StatusBar stbStatusBar 
  18.       Align           =   2  'Align Bottom
  19.       Height          =   375
  20.       Left            =   0
  21.       TabIndex        =   8
  22.       Top             =   1830
  23.       Width           =   5370
  24.       _ExtentX        =   9472
  25.       _ExtentY        =   661
  26.       Style           =   1
  27.       SimpleText      =   ""
  28.       BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7} 
  29.          NumPanels       =   1
  30.          BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
  31.             TextSave        =   ""
  32.             Object.Tag             =   ""
  33.          EndProperty
  34.       EndProperty
  35.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  36.          Name            =   "MS Sans Serif"
  37.          Size            =   8.25
  38.          Charset         =   0
  39.          Weight          =   400
  40.          Underline       =   0   'False
  41.          Italic          =   0   'False
  42.          Strikethrough   =   0   'False
  43.       EndProperty
  44.    End
  45.    Begin VB.PictureBox Picture1 
  46.       Height          =   615
  47.       Left            =   240
  48.       ScaleHeight     =   555
  49.       ScaleWidth      =   3435
  50.       TabIndex        =   5
  51.       Top             =   960
  52.       Width           =   3495
  53.       Begin VB.Label lblTime 
  54.          AutoSize        =   -1  'True
  55.          BackColor       =   &H00FFFFFF&
  56.          BackStyle       =   0  'Transparent
  57.          Caption         =   "00:00:00"
  58.          BeginProperty Font 
  59.             Name            =   "MS Sans Serif"
  60.             Size            =   12
  61.             Charset         =   0
  62.             Weight          =   700
  63.             Underline       =   0   'False
  64.             Italic          =   0   'False
  65.             Strikethrough   =   0   'False
  66.          EndProperty
  67.          ForeColor       =   &H00800000&
  68.          Height          =   300
  69.          Left            =   1800
  70.          TabIndex        =   7
  71.          Top             =   120
  72.          Width           =   1065
  73.       End
  74.       Begin VB.Label Label1 
  75.          AutoSize        =   -1  'True
  76.          Caption         =   "Current Time:"
  77.          BeginProperty Font 
  78.             Name            =   "MS Sans Serif"
  79.             Size            =   12
  80.             Charset         =   0
  81.             Weight          =   700
  82.             Underline       =   0   'False
  83.             Italic          =   0   'False
  84.             Strikethrough   =   0   'False
  85.          EndProperty
  86.          Height          =   300
  87.          Index           =   0
  88.          Left            =   120
  89.          TabIndex        =   6
  90.          Top             =   120
  91.          Width           =   1635
  92.       End
  93.    End
  94.    Begin VB.TextBox txtInterval 
  95.       BeginProperty Font 
  96.          Name            =   "MS Sans Serif"
  97.          Size            =   8.25
  98.          Charset         =   0
  99.          Weight          =   700
  100.          Underline       =   0   'False
  101.          Italic          =   0   'False
  102.          Strikethrough   =   0   'False
  103.       EndProperty
  104.       Height          =   300
  105.       Left            =   2685
  106.       TabIndex        =   4
  107.       Text            =   "1"
  108.       Top             =   360
  109.       Width           =   495
  110.    End
  111.    Begin VB.CommandButton cmdButton 
  112.       Caption         =   "E&xit"
  113.       Height          =   495
  114.       Index           =   2
  115.       Left            =   3975
  116.       TabIndex        =   2
  117.       Top             =   1200
  118.       Width           =   1215
  119.    End
  120.    Begin VB.CommandButton cmdButton 
  121.       Caption         =   "&Disconnect"
  122.       Enabled         =   0   'False
  123.       Height          =   495
  124.       Index           =   1
  125.       Left            =   3975
  126.       TabIndex        =   1
  127.       Top             =   660
  128.       Width           =   1215
  129.    End
  130.    Begin VB.CommandButton cmdButton 
  131.       Caption         =   "&Connect"
  132.       Default         =   -1  'True
  133.       Height          =   495
  134.       Index           =   0
  135.       Left            =   3975
  136.       TabIndex        =   0
  137.       Top             =   120
  138.       Width           =   1215
  139.    End
  140.    Begin VB.Label Label2 
  141.       BackStyle       =   0  'Transparent
  142.       Caption         =   "Update Interval:"
  143.       BeginProperty Font 
  144.          Name            =   "MS Sans Serif"
  145.          Size            =   8.25
  146.          Charset         =   0
  147.          Weight          =   700
  148.          Underline       =   0   'False
  149.          Italic          =   0   'False
  150.          Strikethrough   =   0   'False
  151.       EndProperty
  152.       Height          =   285
  153.       Left            =   1140
  154.       TabIndex        =   3
  155.       Top             =   435
  156.       Width           =   1500
  157.    End
  158.    Begin VB.Image Image1 
  159.       Height          =   480
  160.       Index           =   1
  161.       Left            =   480
  162.       Top             =   240
  163.       Visible         =   0   'False
  164.       Width           =   480
  165.    End
  166.    Begin VB.Image Image1 
  167.       Height          =   480
  168.       Index           =   0
  169.       Left            =   480
  170.       Top             =   240
  171.       Width           =   480
  172.    End
  173. Attribute VB_Name = "frmCBCli"
  174. Attribute VB_GlobalNameSpace = False
  175. Attribute VB_Creatable = False
  176. Attribute VB_PredeclaredId = True
  177. Attribute VB_Exposed = False
  178. Option Explicit
  179. 'Please see the notes in the server project for how this application works.
  180. Dim objCbSvr As Object
  181. Dim mnCallInterval  As Integer
  182. Dim mbIsConnected As Boolean
  183. Private Sub cmdButton_Click(Index As Integer)
  184.   Static objMyClassInstance As Object
  185.   Dim bSuccess As Integer
  186.   Dim bRetVal As Boolean
  187.   Dim iCounter As Integer
  188.   ' Used by OLE Collision Handler
  189.   Dim nCurErrorCount As Integer
  190.   Const MAX_ERROR_COUNT = 10
  191.   On Error GoTo cmdButtonError
  192.   Screen.MousePointer = vbHourglass
  193.   Select Case Index
  194.     Case 0  'Connect
  195.       Set objMyClassInstance = New CbClientProj.CbClientClass
  196.       Set objCbSvr = CreateObject("CbServerProj.CbServerClass")
  197.       mnCallInterval = Val(txtInterval.Text)
  198.       bSuccess = objCbSvr.SetInterval(mnCallInterval)
  199.       If objCbSvr.AddObjectReference(objMyClassInstance) Then
  200.         mbIsConnected = True
  201.         cmdButton(0).Enabled = False
  202.         cmdButton(1).Enabled = True
  203.         cmdButton(2).Enabled = False
  204.         Image1(0).Visible = False
  205.         Image1(1).Visible = True
  206.         stbStatusBar.SimpleText = "Connection Successful..."
  207.         
  208.       Else
  209.         stbStatusBar.SimpleText = "Connect Failed..."
  210.       
  211.       End If
  212.       
  213.     Case 1  'Disconnect
  214.         'Increase callback interval to reduce the risk of collision.
  215.         bSuccess = objCbSvr.SetInterval(30)
  216.         'Now tell the server to disconnect from us.
  217. 100   If objCbSvr.DropObjectReference(objMyClassInstance) Then
  218. 110   mbIsConnected = False
  219.         'Dereference our local object
  220.         Set objMyClassInstance = Nothing
  221.         'Dereference the server object.
  222.         Set objCbSvr = Nothing
  223.         cmdButton(0).Enabled = True
  224.         cmdButton(1).Enabled = False
  225.         cmdButton(2).Enabled = True
  226.         Image1(0).Visible = True
  227.         Image1(1).Visible = False
  228.         stbStatusBar.SimpleText = "Disconnect Successful..."
  229.         
  230.       Else
  231.         stbStatusBar.SimpleText = "Disconnect Failed..."
  232.         
  233.       End If
  234.     Case 2  'Exit
  235.       Unload Me
  236.   End Select
  237.   Screen.MousePointer = vbDefault
  238.   Exit Sub
  239. cmdButtonError:
  240.   'When using asynchronous callbacks between two OLE objects, this error checking code is
  241.   'necessary to deal with a chance of a collision.  This collision can occur when a client and
  242.   'server attempt to call each at the same time. This error handler forces the client to wait for a
  243.   'random period of time and retry the failed operation.  During this wait time, the server should
  244.   'complete it's call to the client allowing the client to succeed when it retrys the call to the server.
  245.   'The same error handling code also needs to be implemented in the server object.
  246.   If Erl = 100 And Err = &H80010001 Then
  247.     If nCurErrorCount >= MAX_ERROR_COUNT Then
  248.       MsgBox "Unable to release server reference.  Retry later.", vbExclamation, "Remote Server Disconnect Error"
  249.       Resume EndOfError
  250.     Else
  251.       For iCounter = 1 To 2000 * Rnd()
  252.         DoEvents
  253.       Next iCounter
  254.       Resume
  255.     End If
  256.   End If
  257.   Screen.MousePointer = vbDefault
  258.   MsgBox Error$, vbCritical, "cmdButton Error"
  259. EndOfError:
  260. End Sub
  261. Private Sub Form_Load()
  262.   Me.Left = (Screen.Width - Me.Width) / 2
  263.   Me.Top = (Screen.Height - Me.Height) / 2
  264. End Sub
  265. Private Sub txtInterval_LostFocus()
  266.         Dim bSuccess As Integer
  267.         Dim iCounter As Integer
  268.         
  269.         ' Used by OLE Collision Handler
  270.         Dim nCurErrorCount As Integer
  271.         Const MAX_ERROR_COUNT = 10
  272.         On Error GoTo SetIntervalError
  273.         If Val(txtInterval.Text) <> mnCallInterval And mbIsConnected Then
  274.           mnCallInterval = Val(txtInterval.Text)
  275. 100     bSuccess = objCbSvr.SetInterval(mnCallInterval)
  276. 110  End If
  277. SetIntervalError:
  278.   'When using asynchronous callbacks between two OLE objects, this error checking code is
  279.   'necessary to deal with a chance of a collision.  This collision can occur when a client and
  280.   'server attempt to call each at the same time. This error handler forces the client to wait for a
  281.   'random period of time and retry the failed operation.  During this wait time, the server should
  282.   'complete it's call to the client allowing the client to succeed when it retrys the call to the server.
  283.   'The same error handling code also needs to be implemented in the server object.
  284.   If Erl = 100 And Err = &H80010001 Then
  285.     If nCurErrorCount >= MAX_ERROR_COUNT Then
  286.       MsgBox "Unable to update timer interval.  Retry later.", vbExclamation, "Update Interval Error"
  287.       Resume EndOfError
  288.     Else
  289.       For iCounter = 1 To 2000 * Rnd()
  290.         DoEvents
  291.       Next iCounter
  292.       Resume
  293.     End If
  294.   End If
  295. EndOfError:
  296. End Sub
  297.