Aşağıdaki fonksiyon bir dosyanın uzantısını döndürüyor.

Function GetExtension(Filename As String)

Dim PthPos, ExtPos As Integer

For i = Len(Filename) To 1 Step -1 ' Go from the Length of the filename, to the first character by 1.

If Mid(Filename, i, 1) = "." Then ' If the current position is '.' then...

ExtPos = i ' ...Change the ExtPos to the number.

For j = Len(Filename) To 1 Step -1 ' Do the Same...

If Mid(Filename, j, 1) = "" Then ' ...but for ''.

PthPos = j ' Change the PthPos to the number.

Exit For ' Since we found it, don't search any more.

End If

Next j

Exit For ' Since we found it, don't search any more.

End If

Next i

If PthPos > ExtPos Then

Exit Function ' No extension.

Else

If ExtPos = 0 Then Exit Function ' If there is not extension, then exit sub.

GetExtension = Mid(Filename, ExtPos + 1, Len(Filename) - ExtPos) 'Messagebox the Extension

End If

End Function

Fonksiyonu aşağıdaki gibi çağırabilirsiniz.

FileExt = GetExtension("c:windowsvbvb.exe")

Aşağıdaki kod parçası da yüzde ölçüsünü kullanarak dosya kopyalamaya yarıyor. Göze güzel görünen uygulamalar yapmak için iyi bir şey.

Function CopyFile (src As String, dst As String) As Single

'L. Serflaten 1996

Static Buf$

Dim BTest!, FSize!

Dim Chunk%, F1%, F2%

Const BUFSIZE = 1024

'This routine will copy a file while providing a means

'to support a percent gauge. Ex. your display routine

'is called "PercentDone" and accepts the values 0-100.

'Error support is provided.

'

'A larger BUFSIZE is best, but do not attempt to exceed

'64 K (60000 would be fine)

'

'The size of the copied file is returned on success

'0 is returned on failure

If Dir(src) = "" Then MsgBox "File not found": Exit Function

If Len(Dir(dst)) Then

If MsgBox(UCase(dst) & Chr(13) & Chr(10) & "File exists. Overwrite?", 4) <> 6 Then Exit Function

Kill dst

End If

On Error GoTo FileCopyError

F1 = FreeFile

Open src For Binary As F1

F2 = FreeFile

Open dst For Binary As F2

FSize = LOF(F1)

BTest = FSize - LOF(F2)

Do

If BTest < BUFSIZE Then

Chunk = BTest

Else

Chunk = BUFSIZE

End If

Buf = String(Chunk, " ")

Get F1, , Buf

Put F2, , Buf

BTest = FSize - LOF(F2)

' __Call percent display here__

'PercentDone ( 100 - Int(100 * BTest/FSize) )

Loop Until BTest = 0

Close F1

Close F2

CopyFile = FSize

Exit Function

FileCopyError:

MsgBox "Copy Error!"

Close F1

Close F2

Exit Function

End Function

Önce formunuza bir ProgressBar kontrolü ekleyip ardından aşağıdaki kodu kullanarak dosya kopyalayabilirsiniz.

ProgressBar1.Value = CopyFile (Which_File*, To_Where**)

* = Kopyalanacak dosya
** = Kopyalanacağı yer