Dan Appleman's Visual Bas…s Guide to the Win32 API/Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD/VB5PG32.mdf/vbpg32/samples5/ch14/frmserv.frm

Visual Basic Form | 1997-02-16 | 5.5 KB | 168 lines

VERSION 5.00
Begin VB.Form frmServer
   Caption         =   "CheckStand"
   ClientHeight    =   2865
   ClientLeft      =   5475
   ClientTop       =   1770
   ClientWidth     =   4200
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   2865
   ScaleWidth      =   4200
   Begin VB.ListBox lstCustomers
      Height          =   1395
      ItemData        =   "FRMSERV.frx":0000
      Left            =   300
      List            =   "FRMSERV.frx":0007
      TabIndex        =   3
      Top             =   1200
      Width           =   3495
   End
   Begin VB.Timer Timer1
      Enabled         =   0   'False
      Interval        =   400
      Left            =   -120
      Top             =   780
   End
   Begin VB.CheckBox chkOpen
      Caption         =   "Open"
      Height          =   255
      Left            =   2460
      TabIndex        =   2
      Top             =   240
      Width           =   915
   End
   Begin VB.TextBox txtCheck
      Height          =   315
      Left            =   1380
      TabIndex        =   0
      Text            =   "1"
      Top             =   180
      Width           =   795
   End
   Begin VB.Label lblStatus
      Height          =   195
      Left            =   360
      TabIndex        =   4
      Top             =   780
      Width           =   3495
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      Caption         =   "Checkstand:"
      Height          =   255
      Left            =   180
      TabIndex        =   1
      Top             =   240
      Width           =   1095
   End
Attribute VB_Name = "frmServer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' Copyright
 1997 by Desaware Inc. All Rights Reserved
Dim FileHandle As Long      ' Handle of open file
Dim MappingHandle As Long   ' Handle to file mapping
Dim MappingAddress As Long  ' Address of file mapping
Dim Security As SECURITY_ATTRIBUTES
Dim MutexHandle As Long     ' Handle of mutex for this server
Private Sub chkOpen_Click()
    Dim usename$
    Dim InitialStand As CheckStand
    Dim written&
    ' Note lack of error checking here
    usename$ = "ChkStd" & txtCheck.Text
    If chkOpen.value = 1 Then
        If FileHandle <> 0 Then Exit Sub
        ' Create new file, read write access, exclusive use,
        FileHandle = CreateFile(usename$, GENERIC_READ Or GENERIC_WRITE, _
                                0, Security, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL Or FILE_FLAG_RANDOM_ACCESS, 0)
        If FileHandle = -1 Then
            MsgBox "Can't create file"
            FileHandle = 0
            Exit Sub
        End If
        ' Write the initial file info
        Call WriteFile(FileHandle, InitialStand, Len(InitialStand), written, 0)
        Call FlushFileBuffers(FileHandle)
        ' Now we need a mapping
        MappingHandle = CreateFileMapping(FileHandle, Security, PAGE_READWRITE, 0, 0, usename$ & "map")
        If MappingHandle = 0 Then
            MsgBox "Can't create file mapping"
            Exit Sub
        End If
        MappingAddress = MapViewOfFile(MappingHandle, FILE_MAP_ALL_ACCESS, 0, 0, 0)
        If MappingAddress = 0 Then
            MsgBox "Can't map view of the file"
            Exit Sub
        End If
        ' Don't get initial ownership
        MutexHandle = CreateMutexBynum(0, False, usename$ & "mutex")
        Timer1.Enabled = True   ' Start watching for customers
    Else
        CleanUp
        lblStatus.Caption = "Closed"
    End If
End Sub
Private Sub Form_Load()
    With Security
        .nLength = Len(Security)
        .lpSecurityDescriptor = 0
        .bInheritHandle = True   ' Doesn't really matter
    End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
    ' Remember, this won't get called if you Stop without
    ' closing the main window.
    CleanUp
End Sub
Private Sub CleanUp()
    ' Remember, this won't get called if you Stop without
    ' closing the main window.
    Timer1.Enabled = False
    If MappingAddress <> 0 Then
        Call UnmapViewOfFile(MappingAddress)
        MappingAddress = 0
    End If
    If MappingHandle <> 0 Then
        Call CloseHandle(MappingHandle)
        MappingHandle = 0
    End If
    If FileHandle <> 0 Then
        Call CloseHandle(FileHandle)
        FileHandle = 0
    End If
    If MutexHandle <> 0 Then
        Call CloseHandle(MutexHandle)
        MutexHandle = 0
    End If
End Sub
Private Sub Timer1_Timer()
    Dim cs As CheckStand
    Static item%
    Static tot As Single
    ' Look at the checkstand
    agCopyData ByVal MappingAddress, cs, Len(cs)
    If cs.Done Then
        If cs.Total <> 0 Then Exit Sub ' Waiting for payment
        If item = 0 Then lblStatus.Caption = "Checking out " & cs.Client
        tot = tot + cs.Prices(item)
        item = item + 1
        ' Stop at free item anyway
        If item > UBound(cs.Prices) Or cs.Prices(item - 1) = 0 Then ' Done
            lstCustomers.AddItem cs.Client & " " & Format$(tot, "0.00")
            cs.Total = tot
            cs.Done = 0
            item = 0
            tot = 0
            lblStatus.Caption = "Waiting to pay"
        End If
        agCopyData cs, ByVal MappingAddress, Len(cs)
    Else
        lblStatus.Caption = "Waiting for customer"
    End If
End Sub