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