Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/fcc110/fcctst.frm

Visual Basic Form | 1995-05-07 | 11.9 KB | 428 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "FCC Test Program"
   ClientHeight    =   3450
   ClientLeft      =   1125
   ClientTop       =   1470
   ClientWidth     =   7185
   Height          =   3855
   Left            =   1065
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3450
   ScaleWidth      =   7185
   Top             =   1125
   Width           =   7305
   Begin TextBox Rpercent
      Height          =   285
      Left            =   3360
      TabIndex        =   9
      Text            =   "10"
      Top             =   2760
      Width           =   735
   End
   Begin CheckBox Rwrites
      Height          =   255
      Left            =   5880
      TabIndex        =   10
      Top             =   2760
      Width           =   255
   End
   Begin TextBox Rsize
      Height          =   285
      Left            =   3360
      TabIndex        =   8
      Text            =   "2048"
      Top             =   2400
      Width           =   735
   End
   Begin TextBox Dblk
      Height          =   285
      Left            =   3360
      TabIndex        =   7
      Text            =   "8192"
      Top             =   2040
      Width           =   735
   End
   Begin TextBox Dcache
      Height          =   285
      Left            =   3360
      TabIndex        =   6
      Text            =   "128"
      Top             =   1680
      Width           =   735
   End
   Begin Timer Timer2
      Left            =   3240
      Top             =   0
   End
   Begin CommandButton Frand
      Caption         =   "Random"
      Height          =   495
      Left            =   120
      TabIndex        =   4
      Top             =   2160
      Width           =   1455
   End
   Begin Timer Timer1
      Left            =   2520
      Top             =   0
   End
   Begin CommandButton Cancel
      Caption         =   "Cancel"
      Enabled         =   0   'False
      Height          =   495
      Left            =   120
      TabIndex        =   5
      Top             =   2760
      Width           =   1455
   End
   Begin Frame Frame1
      Caption         =   "Compress"
      Height          =   975
      Left            =   5640
      TabIndex        =   11
      Top             =   1560
      Width           =   1095
      Begin OptionButton Option2
         Caption         =   "Off"
         Height          =   255
         Left            =   240
         TabIndex        =   14
         Top             =   600
         Width           =   615
      End
      Begin OptionButton Option1
         Caption         =   "On"
         Height          =   255
         Left            =   240
         TabIndex        =   13
         Top             =   240
         Value           =   -1  'True
         Width           =   735
      End
   End
   Begin CommandButton Copy
      Caption         =   "Copy"
      Height          =   495
      Left            =   120
      TabIndex        =   3
      Top             =   1560
      Width           =   1455
   End
   Begin TextBox Destination
      Height          =   285
      Left            =   2040
      TabIndex        =   2
      Text            =   "c:\fcc.tmp"
      Top             =   840
      Width           =   2055
   End
   Begin TextBox Source
      Height          =   285
      Left            =   2040
      TabIndex        =   1
      Top             =   480
      Width           =   2055
   End
   Begin Label Label7
      Caption         =   "(128-16384)"
      Height          =   255
      Left            =   4200
      TabIndex        =   25
      Top             =   2040
      Width           =   1335
   End
   Begin Label Label4
      Caption         =   "(1-2048)"
      Height          =   255
      Left            =   4200
      TabIndex        =   24
      Top             =   1680
      Width           =   855
   End
   Begin Label Label11
      Caption         =   "Random %:"
      Height          =   255
      Left            =   1800
      TabIndex        =   23
      Top             =   2760
      Width           =   1215
   End
   Begin Label Label10
      Caption         =   "Random Writes:"
      Height          =   255
      Left            =   4320
      TabIndex        =   22
      Top             =   2760
      Width           =   1455
   End
   Begin Label Label9
      Caption         =   "Random Size:"
      Height          =   255
      Left            =   1800
      TabIndex        =   21
      Top             =   2400
      Width           =   1335
   End
   Begin Label Label6
      Caption         =   "Cache Size (K):"
      Height          =   255
      Left            =   1800
      TabIndex        =   20
      Top             =   1680
      Width           =   1455
   End
   Begin Label Label5
      Caption         =   "Block Size:"
      Height          =   255
      Left            =   1800
      TabIndex        =   19
      Top             =   2040
      Width           =   1455
   End
   Begin Label elapsed
      Height          =   255
      Left            =   240
      TabIndex        =   18
      Top             =   1200
      Width           =   6135
   End
   Begin Label Dsize
      Height          =   255
      Left            =   4320
      TabIndex        =   17
      Top             =   840
      Width           =   2175
   End
   Begin Label Ssize
      Height          =   255
      Left            =   4320
      TabIndex        =   16
      Top             =   480
      Width           =   2895
   End
   Begin Label Label3
      Caption         =   "Version:"
      Height          =   255
      Left            =   240
      TabIndex        =   15
      Top             =   120
      Width           =   1815
   End
   Begin Label Label2
      Caption         =   "Destination File:"
      Height          =   255
      Left            =   240
      TabIndex        =   12
      Top             =   840
      Width           =   1575
   End
   Begin Label Label1
      Caption         =   "Source File:"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   480
      Width           =   1455
   End
Dim rpsize As Long
Dim rprocessed As Long
Dim tstart As Double
Dim progress As FCC_COPYT
Sub Cancel_Click ()
    progress.cancel = 1
    Form1.MousePointer = 11
    status% = DoEvents()
End Sub
Function Comma (n As Long) As String
    Comma = Format(n, "#,###,###,##0")
End Function
Sub Copy_Click ()
    s$ = Source.Text
    d$ = Destination.Text
    If d$ = "" Then
        MsgBox "Destination Not Specified", MB_ICONINFORMATION, ""
        Exit Sub
    End If
    copy.Enabled = False
    frand.Enabled = False
    cancel.Enabled = True
    timer1.Interval = 500
    elapsed.Caption = ""
    progress.hWnd = Form1.hWnd
    progress.message = 257
    progress.wparam = 256
    tstart = Timer
    If option1.Value = True Then
        er% = FCC_copy(s$, d$, Val(Dblk.Text), FCC_CDEFAULT, progress)
    Else
        er% = FCC_copy(s$, d$, Val(Dblk.Text), FCC_CNONE, progress)
    End If
    timer1_timer
    timer1.Interval = 0
    Form1.MousePointer = 0
    i% = FCC_exists(d$, v%, l&, p&)
    If i% = 0 Then Dsize.Caption = Comma(p&) + " bytes"
    If er% <> 0 Then
        s$ = FCC_err(er%)
        MsgBox s$, MB_ICONINFORMATION, "ERROR"
    Else
        MsgBox "File Copied", MB_ICONOK, ""
    End If
    copy.Enabled = True
    frand.Enabled = True
    cancel.Enabled = False
End Sub
Sub Form_KeyUp (keycode As Integer, Shift As Integer)
    If keycode = 256 Then
        state% = DoEvents()
    End If
End Sub
Sub Form_Load ()
    s$ = "Version: " + Str$(FCC_version())
    Label3.Caption = s$
End Sub
Sub Frand_Click ()
    frand.Enabled = False
    copy.Enabled = False
    cancel.Enabled = True
    Randomize
    d$ = Destination.Text
    rprocessed = 0
    progress.cancel = 0
    timer2.Interval = 500
    tstart = Timer
    If Rwrites.Value = 1 Then
        e% = random_test(d$, Val(Dcache.Text), Val(Dblk.Text), Val(Rsize.Text), Val(Rpercent.Text), True)
    Else
        e% = random_test(d$, Val(Dcache.Text), Val(Dblk.Text), Val(Rsize.Text), Val(Rpercent.Text), False)
    End If
    timer2.Interval = 0
    Form1.MousePointer = 0
    ShowElapsed (rprocessed)
    i% = FCC_exists(d$, v%, l&, p&)
    If i% = 0 Then Dsize.Caption = Comma(p&) + " bytes"
    If e% <> 0 Then
        s$ = FCC_err(e%)
        MsgBox s$, MB_ICONINFORMATION, "ERROR"
    Else
        MsgBox "", MB_ICONOK, ""
    End If
    copy.Enabled = True
    frand.Enabled = True
    cancel.Enabled = False
End Sub
Function random_test (s$, kbytes%, blksize%, buffsize%, percent%, writes%)
   Dim pos As Long
   Dim flen As Long
   Dim h As Integer
   Dim num As Integer
   Dim area As Long
   Dim k As Long
   ReDim buff((buffsize / 2) + 1) As Integer
   If percent > 100 Then percent = 100
   If percent < 1 Then percent = 1
   If writes = True Then
        e% = FCC_open(h, s$, FCC_RDWR, 0, kbytes%, blksize%)
   Else
        e% = FCC_open(h, s$, FCC_RDONLY, 0, kbytes%, blksize%)
   End If
   If e% <> 0 Then
      random_test = e%
      Exit Function
   End If
   e% = FCC_length(h, flen)
   If e% <> 0 Then
      random_test = e%
      Exit Function
   End If
   If num > flen Then num = flen / 2 + 1
   While True
      num = Rnd * buffsize% + 1
      If Rnd * 100 > percent Then
        area = (flen - num) * (percent / 100)
      Else
        area = flen - num
      End If
      pos = Rnd * area
      e% = FCC_seek(h, pos, FCC_SEEKSET, newpos&)
      If e% <> 0 Then
         random_test = e%
         Exit Function
      End If

      e% = FCC_read(h, buff(0), num, k)
      If e% <> 0 Then
         random_test = e%
         Exit Function
      End If
      If k <> num Then
         random_test = FCC_ERR_READ
         Exit Function
      End If
      rprocessed = rprocessed + num
      If writes = True Then
        If Rnd * 100 > percent Then
            area = (flen - num) * (percent / 100)
        Else
            area = flen - num
        End If
        pos = Rnd * area
        e% = FCC_seek(h, pos, FCC_SEEKSET, newpos&)
        If e% <> 0 Then
             random_test = e%
            Exit Function
        End If
        e% = FCC_write(h, buff(0), num, k)
        If e% <> 0 Then
             random_test = e%
            Exit Function
        End If
        If k <> num Then
             random_test = FCC_ERR_READ
            Exit Function
        End If
        rprocessed = rprocessed + num
      End If

      status% = DoEvents()
      If progress.cancel <> 0 Then
         e% = FCC_close(h)
         If e% = 0 Then e% = FCC_ERR_CANCELED
         random_test = e%
         Exit Function
      End If

      e% = FCC_plength(h, rpsize)
      If e% <> 0 Then
         random_test = e%
         Exit Function
      End If
   Wend
End Function
Sub ShowElapsed (bytes&)
    s$ = Comma(bytes&) + " bytes processed"
    n# = Timer - tstart
    If n# <> 0 Then
        s$ = s$ + " (" + Format((bytes& / 1024) / n#, "0.00") + " K/sec)"
    End If
    elapsed.Caption = s$
End Sub
Sub timer1_timer ()
    If progress.length = progress.plength Then
        Ssize.Caption = Comma(progress.length) + " Bytes"
    Else
        Ssize.Caption = Comma(progress.plength) + " (" + Comma(progress.length) + ") bytes"
    End If
    If progress.length > 0 Then
        ShowElapsed (progress.curpos)
        i% = (progress.curpos * 100&) / progress.length
        Dsize.Caption = Str$(i%) + "% Done"
    End If
End Sub
Sub Timer2_Timer ()
    ShowElapsed (rprocessed)
    Dsize.Caption = Comma(rpsize) + " bytes"
End Sub