filetg.frm

delphi实现简单文件复制

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   1275
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3720
   LinkTopic       =   "Form1"
   ScaleHeight     =   1275
   ScaleWidth      =   3720
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command2 
      Caption         =   "删除"
      Height          =   375
      Left            =   2160
      TabIndex        =   1
      Top             =   240
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "操作"
      Height          =   375
      Left            =   360
      TabIndex        =   0
      Top             =   240
      Width           =   1095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Type SHFILEOPSTRUCT
        hwnd As Long
        wFunc As Long       '对文件的操作指令
        pFrom As String     '源文件或路径
        pTo As String       '目的文件或路径
        fFlags As Integer   '操作标志
        fAnyOperationsAborted As Long
        hNameMappings As Long
        lpszProgressTitle As String
End Type

Private Declare Function SHFileOperation Lib _
        "shell32" _
        (lpFileOp As SHFILEOPSTRUCT) As Long
Private Declare Function GetWindowsDirectory _
        Lib "kernel32" Alias "GetWindowsDirectoryA" _
        (ByVal lpBuffer As String, ByVal nSize As _
        Long) As Long

Const FO_COPY = &H2
Const FO_DELETE = &H3
Const FO_MOVE = &H1
Const FO_RENAME = &H4
Const FOF_ALLOWUNDO = &H40

Dim DirString As String

Private Sub Command1_Click()
    Dim xFile As SHFILEOPSTRUCT
        
    '将Windows目录中的Readme.txt文件复制到Temp目录下
    xFile.pFrom = DirString + "\readme.txt"
    xFile.pTo = DirString + "\temp"
    xFile.fFlags = FOF_ALLOWUNDO
    xFile.wFunc = FO_COPY
    xFile.hwnd = Me.hwnd
    If SHFileOperation(xFile) Then
    End If
    
    '将Temp目录中的Readme.txt文件改名位Temp.txt
    xFile.pFrom = DirString + "\temp\readme.txt"
    xFile.pTo = DirString + "\temp\temp.txt"
    xFile.wFunc = FO_RENAME
    xFile.hwnd = Me.hwnd
    If SHFileOperation(xFile) Then
    End If
    
    '将Temp目录中的Temp.txt移动到根目录下
    xFile.pFrom = DirString + "\temp\temp.txt"
    xFile.pTo = "c:\"
    xFile.wFunc = FO_MOVE
    xFile.hwnd = Me.hwnd
    If SHFileOperation(xFile) Then
    End If
End Sub

Private Sub Command2_Click()
    Dim xFile As SHFILEOPSTRUCT
    
    '删除根目录下的temp.txt文件
    xFile.pFrom = "c:\temp.txt"
    xFile.pTo = "c:\"
    xFile.wFunc = FO_DELETE
    xFile.hwnd = Me.hwnd
    '将fFlags设置为FOF_ALLOWUNDO
    '允许被删除的文件放置到回收站中
    xFile.fFlags = FOF_ALLOWUNDO
    If SHFileOperation(xFile) Then
        Debug.Print "Success"
    End If
End Sub

Private Sub Form_Load()
    Dim astr As String
    Dim l As Long
    
    astr = String(256, 0)
    '获得Windows的根目录
    l = GetWindowsDirectory(astr, Len(astr))
    If l Then
        DirString = Left$(astr, l)
    End If
End Sub