home *** CD-ROM | disk | FTP | other *** search
/ 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 / samples4 / ch13 / frmasync.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-02-16  |  6.5 KB  |  160 lines
  1. VERSION 4.00
  2. Begin VB.Form frmAsync 
  3.    Caption         =   "Asynchronous File I/O Test"
  4.    ClientHeight    =   3015
  5.    ClientLeft      =   1350
  6.    ClientTop       =   1890
  7.    ClientWidth     =   4635
  8.    Height          =   3420
  9.    Left            =   1290
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   3015
  12.    ScaleWidth      =   4635
  13.    Top             =   1545
  14.    Width           =   4755
  15.    Begin VB.CommandButton cmdAsync 
  16.       Caption         =   "Asynchronous"
  17.       Height          =   495
  18.       Left            =   2400
  19.       TabIndex        =   2
  20.       Top             =   540
  21.       Width           =   1335
  22.    End
  23.    Begin VB.CommandButton cmdSync 
  24.       Caption         =   "Synchrounous"
  25.       Height          =   495
  26.       Left            =   420
  27.       TabIndex        =   0
  28.       Top             =   540
  29.       Width           =   1395
  30.    End
  31.    Begin VB.Label lblAsync 
  32.       Caption         =   "0"
  33.       Height          =   255
  34.       Left            =   2460
  35.       TabIndex        =   3
  36.       Top             =   1320
  37.       Width           =   1335
  38.    End
  39.    Begin VB.Label lblSync 
  40.       Caption         =   "0"
  41.       Height          =   255
  42.       Left            =   420
  43.       TabIndex        =   1
  44.       Top             =   1320
  45.       Width           =   1335
  46.    End
  47. Attribute VB_Name = "frmAsync"
  48. Attribute VB_Creatable = False
  49. Attribute VB_Exposed = False
  50. ' Important note - overlapping file I/O as shown
  51. ' here is not particularly useful.  However, see
  52. ' the chapter 14 examples for use of overlapped I/O
  53. ' with pipes.
  54. ' Also note that this example will not be illustrative
  55. ' under Windows 95 which does not support overlapped
  56. ' writes to a disk
  57. Option Explicit
  58. ' Copyright 
  59.  1997 by Desaware Inc. All Rights Reserved
  60. Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
  61. Private Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (ByVal lpEventAttributes As Long, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long
  62. Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
  63. Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
  64. Private Declare Function WriteFileAsync Lib "kernel32" Alias "WriteFile" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As OVERLAPPED) As Long
  65. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  66. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  67. Private Declare Function ResetEvent Lib "kernel32" (ByVal hEvent As Long) As Long
  68. Private Declare Function WaitForMultipleObjects Lib "kernel32" (ByVal nCount As Long, lpHandles As Long, ByVal bWaitAll As Long, ByVal dwMilliseconds As Long) As Long
  69. Private Declare Function GetLastError Lib "kernel32" () As Long
  70. Private Const GENERIC_READ = &H80000000
  71. Private Const GENERIC_WRITE = &H40000000
  72. Private Const CREATE_ALWAYS = 2
  73. Private Const FILE_ATTRIBUTE_NORMAL = &H80
  74. Private Const FILE_FLAG_WRITE_THROUGH = &H80000000
  75. Private Const FILE_FLAG_OVERLAPPED = &H40000000
  76. Private Const FILE_FLAG_NO_BUFFERING = &H20000000
  77. Private Const FILE_FLAG_RANDOM_ACCESS = &H10000000
  78. Private Const FILE_FLAG_SEQUENTIAL_SCAN = &H8000000
  79. Private Const FILE_FLAG_DELETE_ON_CLOSE = &H4000000
  80. Private Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000
  81. Private Const FILE_FLAG_POSIX_SEMANTICS = &H1000000
  82. Private Const FILE_BEGIN = 0
  83. Private Const FILE_CURRENT = 1
  84. Private Const FILE_END = 2
  85. Private Const INFINITE = &HFFFF      '  Infinite timeout
  86. Private Const INVALID_HANDLE_VALUE = -1
  87. Private Const Writes& = 100
  88. Private Type OVERLAPPED
  89.         Internal As Long
  90.         InternalHigh As Long
  91.         offset As Long
  92.         OffsetHigh As Long
  93.         hEvent As Long
  94. End Type
  95. Dim fhnd&
  96. Dim fhndasync&
  97. Dim eventlist(Writes&) As Long
  98. Dim overlaps(Writes&) As OVERLAPPED
  99. Dim FileContents$
  100. Private Sub cmdAsync_Click()
  101.     Dim cnt&, res&
  102.     Dim written&
  103.     lblSync = "0"
  104.     If fhnd = INVALID_HANDLE_VALUE Then
  105.         MsgBox "No valid file pointer"
  106.         Exit Sub
  107.     End If
  108.     For cnt& = 1 To Writes
  109.         With overlaps(cnt)
  110.             .offset = 0
  111.             .OffsetHigh = 0
  112.             ' Make sure event is reset
  113.             Call ResetEvent(eventlist(cnt))
  114.             .hEvent = eventlist(cnt)
  115.         End With
  116.         res = WriteFileAsync(fhndasync, ByVal FileContents$, Len(FileContents$), written, overlaps(cnt))
  117.         lblAsync = Str$(cnt)
  118.         lblAsync.Refresh
  119.     Next cnt
  120.     lblAsync = "Waiting"
  121.     lblAsync.Refresh
  122.     Call WaitForMultipleObjects(Writes, eventlist(1), True, INFINITE)
  123.     lblAsync = "Done"
  124. End Sub
  125. ' Performs synchronous writes to a file
  126. Private Sub cmdSync_Click()
  127.     Dim cnt&, res&
  128.     Dim written&
  129.     lblSync = "0"
  130.     If fhnd = INVALID_HANDLE_VALUE Then
  131.         MsgBox "No valid file pointer"
  132.         Exit Sub
  133.     End If
  134.     For cnt& = 1 To Writes
  135.         Call SetFilePointer(fhnd, 0, 0, FILE_BEGIN)
  136.         res = WriteFile(fhnd, ByVal FileContents$, Len(FileContents$), written, 0)
  137.         lblSync = Str$(cnt)
  138.         lblSync.Refresh
  139.     Next cnt
  140. End Sub
  141. Private Sub Form_Load()
  142.     Dim x&
  143.     fhnd = CreateFile("sync.tmp", GENERIC_READ Or GENERIC_WRITE, 0, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL Or FILE_FLAG_RANDOM_ACCESS, 0)
  144.     fhndasync = CreateFile("async.tmp", GENERIC_READ Or GENERIC_WRITE, 0, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL Or FILE_FLAG_RANDOM_ACCESS Or FILE_FLAG_OVERLAPPED, 0)
  145.     FileContents$ = String$(200000, "A")
  146.     ' Initialize event objects
  147.     For x = 1 To Writes
  148.         eventlist(x) = CreateEvent(0, True, False, vbNullString)
  149.     Next x
  150. End Sub
  151. Private Sub Form_Unload(Cancel As Integer)
  152.     Dim x
  153.     If fhnd <> INVALID_HANDLE_VALUE Then Call CloseHandle(fhnd)
  154.     If fhndasync <> INVALID_HANDLE_VALUE Then Call CloseHandle(fhndasync)
  155.     ' Be sure to clean up events
  156.     For x = 1 To Writes
  157.         If eventlist(x) <> 0 Then DeleteObject (eventlist(x))
  158.     Next x
  159. End Sub
  160.