PDA

View Full Version : کار با فایل ( مهمترین کد ها )



HjSoft
جمعه 28 دی 1386, 16:22 عصر
ادغام دو فایل در یک فایل !!

Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
(ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long

Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100

Private Sub Command1_Click()
Open "file1" For Binary As #1
Open "file2" For Binary As #2
issame% = True
If LOF(1) <> LOF(2) Then
issame% = False
Else
whole& = LOF(1) \ 10000 'number of whole 10,000 byte chunks
part& = LOF(1) Mod 10000 'remaining bytes at end of file
buffer1$ = String$(10000, 0)
buffer2$ = String$(10000, 0)
start& = 1
For x& = 1 To whole& 'this for-next loop will get 10,000
Get #1, start&, buffer1$ 'byte chunks at a time.
Get #2, start&, buffer2$
If buffer1$ <> buffer2$ Then
issame% = False
Exit For
End If
start& = start& + 10000
Next
buffer1$ = String$(part&, 0)
buffer2$ = String$(part&, 0)
Get #1, start&, buffer1$ 'get the remaining bytes at the end
Get #2, start&, buffer2$ 'get the remaining bytes at the end
If buffer1$ <> buffer2$ Then issame% = False
End If
Close
If issame% Then
MsgBox "Files are identical", 64, "Info"
Else
MsgBox "Files are NOT identical", 16, "Info"
End If

End Sub

HjSoft
جمعه 28 دی 1386, 16:24 عصر
Private Sub Command1_Click()
On Error GoTo Error:
Open "ÖÚ ãÓÇÑ ÇáãáÝ ÇáÐí ÊÑíÏ ÇáÊÃßÏ ãä æÌæÏå åäÇ" For Input As #1
Close
MsgBox ("yes")
Exit Sub
Error:
MsgBox ("no")
End Sub

HjSoft
جمعه 28 دی 1386, 16:25 عصر
Private Sub Command1_Click()
Name "c:\Autoexec.bat" As "D:\Autoexec.bat"
End Sub
MsgBox ("no")
End Sub

HjSoft
جمعه 28 دی 1386, 16:26 عصر
Public Function readLine(ByRef strFilePath As String, ByRef nLine _
As Integer) As String

Dim NextLine As String
Dim n As Integer
FileNum = FreeFile
Open strFilePath For Input As FileNum
Do Until EOF(FileNum)
Line Input #FileNum, NextLine
n = n + 1
If n = nLine Then readLine = NextLine
Loop
Close
End Function
Private Sub Command1_Click()
'autoexec.bat áÞÑÇÁÉ ÇáÓØÑ ÇáËÇáË ãä ÇáãáÝ
Text1.Text = readLine("c:\autoexec.bat", 3)
End Sub

'ÃÖÝ Text1 æ Command1 Ëã ÃÖÝ ÇáßæÏ ÇáÊÇáí

HjSoft
جمعه 28 دی 1386, 16:28 عصر
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Sub Command1_Click()
CopyFile "c:\my documents\b.txt", "c:\b.txt", False
End Sub

HjSoft
جمعه 28 دی 1386, 16:30 عصر
Private Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long
Private Sub Command1_Click()
MoveFile "c:\my documents\a.txt", "c:\a.txt"
End Sub

HjSoft
جمعه 28 دی 1386, 16:30 عصر
Private Sub Command1_Click()
Kill ("C:\FileName.fnm")
End Sub