• Home
 · 
• Files/File Controls/Input/Output
 · 
• Copy file from any location to another.Even from CDROM to your system folder.

Copy file from any location to another.Even from CDROM to your system folder.

Copy file from any location to another.Even from CDROM to your system folder.

API Declarations


Public IFileName As String
Public OFileName As String
Public Status As Boolean




Rate Copy file from any location to another.Even from CDROM to your system folder.

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

Private Sub cmdCopy_Click()
If cmdCopy.Caption = "Copy" Then
    Status = True
    cmdCopy.Caption = "S&top"
    CopyModule.FileCopy
Else
    cmdCopy.Caption = "Copy"
    Status = False
End If

End Sub

Private Sub cmdExit_Click()
    Dim VipAsk As Byte
    VipAsk = MsgBox("Do You Really Want To Exit Wipin's 'FILECOPY'.", vbYesNo + vbExclamation, "Wipin")
    If VipAsk = 6 Then End
End Sub

Private Sub Del_Click()
Dim VipCheq As Byte
VipCheq = MsgBox("Do You Really Want To Delete The Selected Folder.", vbYesNo + vbExclamation)
If VipCheq = 6 Then RmDir (Dir2.Path)
Dir2.Refresh
End Sub

Private Sub DelFile_Click()
    On Error GoTo VipErr
    Kill (GetSource)
    VipFile.Refresh
VipErr:
        If Err Then MsgBox "First Choose The File To Be Deleted.", vbCritical, "Wipin"
End Sub

Private Sub Dir2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
    PopupMenu Vipin
End If
End Sub

Private Sub drv2_Change()
On Error GoTo VipErr
Dir2.Path = drv2.Drive
VipErr:
    If Err.Number = 68 Then MsgBox "Device Unavailable.", vbInformation
End Sub

Private Sub Form_Load()
drv2.Drive = "c:"
VipDrv.Drive = "c:"
End Sub

Private Sub MD_Click()
Dim VipdirName As String
VipdirName = InputBox("Enter the Desired Folder's Name: ", "Folder Name", "VipFolder")
MkDir (Dir2.Path + "\" + VipdirName)
End Sub

Private Sub VipDir_Change()
On Error GoTo VipErr
VipFile.Path = VipDir.Path
VipErr:
    If Err.Number = 68 Then MsgBox "Device Unavailable."
End Sub

Private Sub VipDrv_Change()
On Error GoTo VipErr
VipDir.Path = VipDrv.Drive
VipErr:
    If Err.Number = 68 Then MsgBox "Device Unavailable.", vbInformation
End Sub

Private Sub VipFile_Click()
txtDest = VipFile.FileName
IFileName = MyForm.VipFile.Path + "\" + MyForm.VipFile.FileName
lblBytes.Caption = "Source File Size: " & Round((FileLen(IFileName) / 1024) / 1024, 2) & " MB"
End Sub

Private Sub VipFile_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then PopupMenu VipSrc
End Sub


'module:

    Public IFileName As String
    Public OFileName As String
    Public Status As Boolean

Public Sub FileCopy()
    Dim Progress As Long
    Dim InputFile As Integer
    Dim OutputFile As Integer
    Dim FileSize As Long
    Dim f_size As String
    Dim VipCheq As Byte
    On Error GoTo VipCorrupted
    InputFile = FreeFile
    IFileName = GetSource     'Gets the source file name
    OFileName = GetDestination 'gets the destination file name
    If MyForm.txtDest = "" Then
        MsgBox "No Destination file name is specified." + vbCrLf + "Please give a file name to be created.", vbCritical, "Wipin"
        MyForm.txtDest.SetFocus
        MyForm.cmdCopy.Caption = "Copy"
        Exit Sub
    End If
    If Not CheqSrcDestErr Then Exit Sub
    
    If Dir(OFileName) = MyForm.txtDest Then
       VipCheq = MsgBox("A file naming '" + MyForm.txtDest + "' already exists." + vbCrLf + "Do You Want to OverWrite the File.", vbCritical + vbYesNo, "Wipin")
       If VipCheq <> 6 Then
        MyForm.cmdCopy.Caption = "Copy"
        Exit Sub
       End If
    End If
    
    Open IFileName For Binary As InputFile 'opens a file as a Source
    OutputFile = FreeFile
    Open OFileName For Binary Access Write Lock Read As OutputFile 'opens a file for putting the data read from Source
    f_size = String(1048576, " ") 'How much data has to be read
    
    While EOF(InputFile) <> True And Status = True
        
        If FileLen(IFileName) - Loc(OutputFile) < 1048576 Then f_size = String(1024, " ")
        On Error Resume Next
        Get #InputFile, , f_size
        Put #OutputFile, , f_size
        Progress = Round((Loc(OutputFile) / FileLen(IFileName) * 100), 2)
        If Progress > 100 Then Progress = 100
        MyForm.VipBar.Value = Progress
        MyForm.lblCopied.Caption = Round(Loc(OutputFile) / 1024 / 1024, 2) & " MB"
        MyForm.lblInputLoc.Caption = Loc(InputFile)
        DoEvents
VipCorrupted:
        If Err.Number = 75 Then
            'MsgBox Err.Number
            Seek #InputFile, (Loc(InputFile) + 1048576)
        End If
    Wend
    
    Reset
    If Status = True Then
        MsgBox "File Copy Completed.", vbInformation
    Else
        Kill MyForm.Dir2.Path + "\" + MyForm.txtDest
    End If
    MyForm.cmdCopy.Caption = "Copy"
    MyForm.VipBar.Refresh
       
End Sub

Public Function GetSource() As String

    If Right(MyForm.VipDir.Path, 1) <> "\" Then
            GetSource = MyForm.VipFile.Path + "\" + MyForm.VipFile.FileName
        Else
            GetSource = MyForm.VipFile.Path + MyForm.VipFile.FileName
    End If

End Function

Public Function GetDestination() As String
    If Right(MyForm.Dir2.Path, 1) <> "\" Then
            GetDestination = MyForm.Dir2.Path + "\" + MyForm.txtDest
        Else
            GetDestination = MyForm.Dir2.Path + MyForm.txtDest
    End If

End Function

Private Function CheqSrcDestErr() As Boolean
    CheqSrcDestErr = True
    If MyForm.VipFile = Empty Or OFileName = "" Then
        MsgBox "Choose Source and Destination first.", vbCritical, "Source/Dest Error."
        MyForm.cmdCopy.Caption = "Copy"
        CheqSrcDestErr = False
    End If

End Function