ใส่ความเห็น

VB6.0 File copy+ Explanation


Option Explicit
”””’Declare for use to copy file””””””””””’
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const BIF_EDITBOX = &H10
Private Const BIF_VALIDATE = &H20
Private Const BIF_NEWDIALOGSTYLE = &H40
Private Const BIF_BROWSEFORCOMPUTER = &H1000
Private Const MAX_PATH = 260
””””””””””””””””””””””””””””’
””’Declare for keepp valure for each pareameter””””
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
””””””””””””””””””””””””””””””
””Call LIB for use this object””””””””””””””
Private Declare Function SetCurrentDirectory Lib “kernel32” _
Alias “SetCurrentDirectoryA” (ByVal lpPathName As String) As Long

Private Declare Function GetCurrentDirectory Lib “kernel32” _
Alias “GetCurrentDirectoryA” (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Declare Function SHGetPathFromIDList Lib “shell32.dll” _
Alias “SHGetPathFromIDListA” _
(ByVal pidl As Long, ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib “shell32” (lpbi As BrowseInfo) As Long

‘Private Declare Function SHGetPathFromIDList Lib “shell32” _
(ByVal pidList As Long, ByVal lpBuffer As String) As Long

Private Declare Function lstrcat Lib “kernel32” _
Alias “lstrcatA” (ByVal lpString1 As String, ByVal lpString2 As String) As Long
””””””””””””””””””””””””””””””””””””””””””

””””When clcik copy”””””””””””””””””””””””””””’
Private Sub btnCopyFile_Click()
If Not Dir(Trim(txtSource.Text)) = “” Then ‘if txtSouce not emtry”””””’
If Not Dir(Trim(txtDestFolder.Text), vbDirectory) = “” Then
If Not Right(Trim(txtDestFolder.Text), 1) = “\” Then
txtDestFolder.Text = Trim(txtDestFolder.Text) & “\”
End If
Dim destFile As String

destFile = txtDestFolder & Trim(txtDestFileName.Text)
‘Destination file is address of txtDestFolder+File name
If Not Dir(destFile) = “” Then ‘if don’t have destination file then let pop up show
Dim msg As String
msg = “Destination folder already contains file with the same name.” & vbNewLine
msg = msg & “Select YES if you wish to overwrite existing file.” & vbNewLine
msg = msg & “Otherwise select NO and change destination file name.”

If MsgBox(msg, vbInformation + vbYesNo, “File Exists”) = vbYes Then
Kill destFile
FileCopy Trim(txtSource.Text), destFile
Else
‘if everything correct then start to copy file and code will follow this
txtDestFileName.SelStart = 0
txtDestFileName.SelLength = Len(txtDestFileName.Text)
txtDestFileName.SetFocus
Exit Sub
End If
End If
MsgBox “File’s done.”
Else
MsgBox “Please select destination folder.”, vbExclamation, “Missing Destination Folder”
End If
Else
MsgBox “Please select source file.”, vbExclamation, “Missing Source File”
End If
End Sub
”””””””””””””””””””””””””””””””

””’Even clcik for select file ””””””””
Private Sub btnSelectFile_Click()

On Error GoTo ErrHandler

With CommonDialog1 ‘ call this object at component first when need to use
.CancelError = True
.Flags = cdlOFNExplorer
.ShowOpen
If Not .FileName = “” Then
txtSource.Text = .FileName
txtDestFileName.Text = Mid(Trim(txtSource.Text), InStrRev(Trim(txtSource.Text), “\”) + 1)
‘Afer finish select file then file name = txtDestFileName.text
Else
‘if not select any file then ask for select again
txtSource.Text = “Select Source File…”
txtDestFileName.Text = “”
End If
End With

Exit Sub
””””””””””””””””””””””””””’
”””’In case of Error””””””””””””””’
ErrHandler:
Err.Clear
txtSource.Text = “Select Source File…”
txtDestFileName.Text = “”

End Sub
”””””””””””””””””””””””””””’

”””Select Folder for save new file””””””””””
Private Sub btnSelectFolder_Click()
‘===================================
Dim lRet As Long
Dim sBuffer As String
Dim sTitle As String
Dim tBrowseInfo As BrowseInfo
Dim sCurDir As String
Dim lPidl As Long

sTitle = “Select Destination Folder”

With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(sTitle, “”)
.ulFlags = BIF_RETURNONLYFSDIRS Or BIF_DONTGOBELOWDOMAIN Or _
BIF_EDITBOX Or BIF_VALIDATE Or BIF_NEWDIALOGSTYLE
End With

lRet = SHBrowseForFolder(tBrowseInfo)

If lRet > 0 Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lRet, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) – 1)
txtDestFolder.Text = sBuffer
End If

End Sub

Private Sub Form_Load()
txtSource.SelStart = 0
txtSource.SelLength = Len(txtSource.Text)
txtDestFolder.SelStart = 0
txtDestFolder.SelLength = Len(txtDestFolder.Text)
End Sub

ใส่ความเห็น

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / เปลี่ยนแปลง )

Twitter picture

You are commenting using your Twitter account. Log Out / เปลี่ยนแปลง )

Facebook photo

You are commenting using your Facebook account. Log Out / เปลี่ยนแปลง )

Google+ photo

You are commenting using your Google+ account. Log Out / เปลี่ยนแปลง )

Connecting to %s

แปลเพลง VB 6.0 VB 2010 source code

VB2010 แปล แปลเพลง เนื้อเพลง VB 6.0 โหลดเพลงฟรี โหลดเพลง โหลด Mediafire เพลงลูกทุ่ง เพลงใหม่ เพลงลูกทุ่งมาใหม่ เพลงมันส์ โหลดเพลง free เพลงสตริง สตริง

Pathrix's Blog

journal and other stories

%d bloggers like this: