|
刚刚牺牲了午饭查了查资料，写了一段，
command2用来新建文件，command1用来截断文件
Option Explicit
Private Const OFS_MAXPATHNAME = 128
Private Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(OFS_MAXPATHNAME) As Byte
End Type
Private Const OF_READWRITE = &H2
Private Const OF_SHARE_COMPAT = &H0
Private Const OF_SHARE_DENY_NONE = &H40
Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Declare Function SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As Long
Private Const FILE_BEGIN = 0
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Sub Command1_Click()
Dim fHandle As Long
Dim ofs As OFSTRUCT
fHandle = OpenFile("c:\aa.dbc", ofs, OF_READWRITE Or OF_SHARE_DENY_NONE)
If fHandle = -1 Then
MsgBox "OpenError=" & ofs.nErrCode
Else
If SetFilePointer(fHandle, 3, 0, FILE_BEGIN) = -1 Then
MsgBox "SetPointError=" & GetLastError
Else
If SetEndOfFile(fHandle) = 0 Then MsgBox "LastError=" & GetLastError Else MsgBox "Ok"
End If
Call CloseHandle(fHandle)
End If
End Sub
Private Sub Command2_Click()
Open "c:\aa.dbc" For Binary As #1
Put #1, 1, "aa"
Put #1, 5, "bb"
Put #1, 9, "cc"
Close #1
End Sub
|
