#post-id: 2966-19-06
#original-date: 8.09.2008 Mon
#original-time: 7:06 PM
#original-day: 2966
#original-host: WinXP Prof SP2 (Build 2600)

Яойная программа для проверки дисков (например, которые при записи большого количества файлов вырубаются или вырубаются в каком-то одном месте). Почему яойная? Disk - существительное мужского рода ^_^ Хотя, если участь, что программа... ^_^

Attribute VB_Name = "modMain"
Option Explicit

'Const FILE_SIZE = 1024& * 1024& * 50&
Const FILE_SIZE = 1024& * 1024& * 10&

Global Cancel As Boolean

'====================================================================
Public Sub Main()
  asRegisterAppPath
  InitCommonControls
  If Not asIsInIDE Then asSetWindowResIconAll asGetThunderMainHandle(), IDI_APPICON
  
  Dim Buff As BStr
  Dim TMP As Long
  Dim TimeSuffix As BStr
  
  Buff = String(FILE_SIZE, asGetRnd(0, 255))
  TimeSuffix = Format(Now, "yyyymmddhhnnss")
  TMP = 0
  Cancel = False
  
  frmCancel.Show
  DoEvents
  
  Do
    ajpFSO.PutFile "I:\Big File [" & TimeSuffix & "] " & _
                   Format(TMP, "00000000") & ".EAT", Buff, True
    TMP = TMP + 1
    
    frmCancel.Caption = "Disk fucker - " & asFormatLong(TMP)
    If Cancel Then Exit Do
    
    DoEvents
    Sleep 100
  Loop
  
  Unload frmCancel
  Set frmCancel = Nothing
End Sub

И форма:

VERSION 5.00
Begin VB.Form frmCancel 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Disk fucker"
   ClientHeight    =   1305
   ClientLeft      =   4425
   ClientTop       =   5085
   ClientWidth     =   2790
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   9
      Charset         =   204
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1305
   ScaleWidth      =   2790
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   555
      Left            =   600
      TabIndex        =   0
      Top             =   360
      Width           =   1635
   End
   Begin VB.Shape shpBack 
      BackColor       =   &H8000000F&
      BackStyle       =   1  'Opaque
      Height          =   1515
      Left            =   -240
      Top             =   -60
      Width           =   1095
   End
End
Attribute VB_Name = "frmCancel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'====================================================================
Private Sub cmdCancel_Click()
  Cancel = True
End Sub

'====================================================================
Private Sub Form_Load()
  asCenterFormEx Me.hWnd
End Sub

Private Sub Form_Paint()
  PaintDesktop Me.hDC
End Sub

Private Sub Form_QueryUnload(xCancel As Integer, UnloadMode As Integer)
  If UnloadMode <> vbFormCode Then
    Cancel = True
    xCancel = True
  End If
End Sub

Да, лексика у меня порой бывает ничего себе ^^ Впрочем, то с диском и происходит ^^

#music: Caramell\Supergott (Speedy Mixes)\Spelar Ingen Roll (Speedy Mix)

Смотрите также