VB: 写文件时怎样判断磁盘已满

最新推荐文章于 2021-08-11 11:30:16 发布

c945124

最新推荐文章于 2021-08-11 11:30:16 发布

阅读量752

点赞数

分类专栏：程序文章标签： vb 磁盘 string function command object

本文链接：https://blog.csdn.net/c945124/article/details/379196

版权

程序专栏收录该内容

17 篇文章 1 订阅

订阅专栏

建一窗体，加入一Label1 Caption属性为 "将文本框中的文件拷到A:盘"
在其下加一文本框 text1 Text属性为 "c:/command.com"
再下面加一Label2 Caption 属性为空
再下面加一Command1 Caption属性为 "拷贝"
加入以下代码

Option Explicit

Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters) As Long

Private Type DiskInformation
    lpSectorsPerCluster As Long
    lpBytesPerSector As Long
    lpNumberOfFreeClusters As Long
    lpTotalNumberOfClusters As Long
End Type

Private Sub Command1_Click()
On Error GoTo errHandler
Dim fso As Object
Dim temp As String
Dim fsoFile As Object
Dim fileSize As Long
    Text1.Enabled = False
    If Trim(Text1.Text) = "" Then
        MsgBox "输入文件名!", vbInformation, "提示"
    Else
        Set fso = CreateObject("Scripting.FileSystemObject")
        If fso.FileExists(Text1.Text) Then
            Set fsoFile = fso.GetFile(Text1.Text)
            fileSize = fsoFile.Size
        Else
            MsgBox "文件不存在!", vbInformation, "提示"
            Exit Sub
        End If
    End If
    Label2.Caption = "检查软盘驱动器..."
    Label2.Refresh
    temp = Dir("a:/")
    Label2.Caption = "检查软盘容量..."
    If fileSize < GetSize Then
        Label2.Caption = "正在拷贝文件..."
        Label2.Refresh
        fso.CopyFile Text1.Text, "a:/"
    Else
        MsgBox "软盘空间不足!", vbInformation, "提示"
        Label2.Caption = "错误!"
        Exit Sub
    End If
    Label2.Caption = "拷贝成功!"
    Text1.Enabled = True
    Exit Sub
errHandler:
    Label2.Caption = "错误!"
    Text1.Enabled = True
    MsgBox "请插入软盘!", vbInformation, "提示"
End Sub

Private Function GetSize() As Long
    Dim info As DiskInformation
    Dim lAnswer As Long
    Dim lpRootPathName As String
    Dim lpSectorsPerCluster As Long
    Dim lpBytesPerSector As Long
    Dim lpNumberOfFreeClusters As Long
    Dim lpTotalNumberOfClusters As Long
    Dim lBytesPerCluster As Long
    Dim lNumFreeBytes As Double
    Dim sString As String

    lpRootPathName = "a:/"
    lAnswer = GetDiskFreeSpace(lpRootPathName, lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters)
    lBytesPerCluster = lpSectorsPerCluster * lpBytesPerSector
    lNumFreeBytes = lBytesPerCluster * lpNumberOfFreeClusters
    GetSize = lNumFreeBytes
End Function

'Form1
VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   2160
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3945
   LinkTopic       =   "Form1"
   ScaleHeight     =   2160
   ScaleWidth      =   3945
   StartUpPosition =   3 '窗口缺省
   Begin VB.TextBox Text1
      Height          =   315
      Left            =   255
      TabIndex        =   1
      Text            =   "c:/command.com"
      Top             =   675
      Width           =   3390
   End
   Begin VB.CommandButton Command1
      Caption         =   "拷贝"
      Height          =   495
      Left            =   1290
      TabIndex        =   0
      Top             =   1530
      Width           =   1215
   End
   Begin VB.Label Label2
      Height          =   255
      Left            =   240
      TabIndex        =   3
      Top             =   1095
      Width           =   3435
   End
   Begin VB.Label Label1
      Caption         =   "将文本框中的文件拷到A:盘"
      Height          =   255
      Left            =   165
      TabIndex        =   2
      Top             =   195
      Width           =   3225
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'获得A盘可用空间大小
Private Function GetSize() As Long
    Dim info As DiskInformation
    Dim lAnswer As Long
    Dim lpRootPathName As String
    Dim lpSectorsPerCluster As Long
    Dim lpBytesPerSector As Long
    Dim lpNumberOfFreeClusters As Long
    Dim lpTotalNumberOfClusters As Long
    Dim lBytesPerCluster As Long
    Dim lNumFreeBytes As Double
    Dim sString As String

    lpRootPathName = "a:/"
    lAnswer = GetDiskFreeSpace(lpRootPathName, lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters)
    lBytesPerCluster = lpSectorsPerCluster * lpBytesPerSector
    lNumFreeBytes = lBytesPerCluster * lpNumberOfFreeClusters
    GetSize = lNumFreeBytes
End Function