打印

【xnwxq】AppendToLog一个API方式存取日志文件的模块

[复制链接]
1432|0
手机看帖
扫描二维码
随时随地手机跟帖
跳转到指定楼层
楼主
xnwxq|  楼主 | 2009-8-23 15:51 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
API, App, pen, TE, ST
'**************************************
' 模块名称: AppendToLog
' 功能描述:一个很不错的日志文件写入模块,不同于
'     open/print/close写文件方法,这个模块使用API
'     存取文件,这样保证文件能正确的存取,及时被
'     存取的文件正被其他用户打开。这个模块是最安全
'     有效的文件写入方法,用于日志文件的创建,当然
'     也可以用于其他文件存取。
'**************************************
'API 声明
Const GENERIC_WRITE = &H40000000
Const FILE_SHARE_READ = &H1
Const Create_NEW = 1
Const OPEN_EXISTING = 3
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_BEGIN = 0
Const INVALID_HANDLE_VALUE = -1
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'**************************************
' 模块名称: AppendToLog
' 功能描述:一个很不错的日志文件写入模块,不同于
'     open/print/close写文件方法,这个模块使用API
'     存取文件,这样保证文件能正确的存取,及时被
'     存取的文件正被其他用户打开。这个模块是最安全
'     有效的文件写入方法,用于日志文件的创建,当然
'     也可以用于其他文件存取。
' 输入参数:lpFileName As String - 要写入的日志文件名称
' 返 回 值:True 成功, False 失败
'**************************************
Private Function AppendToLog(ByVal lpFileName As String, ByVal sMessage As String) As Boolean
    'appends a string to a text file. it's u
    '     p to the coder to add a CR/LF at the end
    '     
    'of the string if (s)he so desires.
    'assume failure
    AppendToLog = False
   
    'exit if the string cannot be written to
    '     disk
    If Len(sMessage) < 1 Then Exit Function
   
    'get the size of the file (if it exists)
    '     
    Dim fLen As Long
    fLen = 0
   

    If (Len(Dir(lpFileName))) Then
        fLen = FileLen(lpFileName)
    End If
   
    'open the log file, create as necessary
    Dim hLogFile As Long
    hLogFile = CreateFile(lpFileName, GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, _
    IIf(Len(Dir(lpFileName)), OPEN_EXISTING, Create_NEW), _
    FILE_ATTRIBUTE_NORMAL, 0&)
   
    'ensure the log file was opened properly
    '     
    If (hLogFile = INVALID_HANDLE_VALUE) Then Exit Function
   
    'move file pointer to end of file if fil
    '     e was not created

    If (fLen <> 0) Then

        If (SetFilePointer(hLogFile, fLen, ByVal 0&, FILE_BEGIN) = &HFFFFFFFF) Then
            'exit sub if the pointer did not set cor
            '     rectly
            CloseHandle (hLogFile)
            Exit Function
        End If
    End If
   
    'convert the source string to a byte arr
    '     ay for use with WriteFile
    Dim lTemp As Long
    ReDim TempArray(0 To Len(sMessage) - 1) As Byte
   

    For lTemp = 1 To Len(sMessage)
        TempArray(lTemp - 1) = Asc(Mid$(sMessage, lTemp, 1))
    Next
   
    'write the string to the log file

    If (WriteFile(hLogFile, TempArray(0), Len(sMessage), lTemp, ByVal 0&) <> 0) Then
        'the data was written correctly
        AppendToLog = True
    End If
   
    'flush buffers and close the file
    FlushFileBuffers (hLogFile)
    CloseHandle (hLogFile)
   
End Function

相关帖子

发新帖 我要提问
您需要登录后才可以回帖 登录 | 注册

本版积分规则

个人签名:我们都是风雨中的孩子,手牵着手才不会跌倒

162

主题

294

帖子

1

粉丝