• VB6-AppendToLog 通过API写入日志


    工作中免不了需要为自己的程序添加日志,我也从网上扒拉了一个老外写的模块,修改修改了下,凑合用吧。

     1 Option Explicit
     2 '**************************************
     3 ' 模块名称: AppendToLog 通过API写入日志
     4 '**************************************
     5 'API 声明
     6 Private Const GENERIC_WRITE = &H40000000
     7 Private Const FILE_SHARE_READ = &H1
     8 Private Const Create_NEW = 1
     9 Private Const OPEN_EXISTING = 3
    10 Private Const FILE_ATTRIBUTE_NORMAL = &H80
    11 Private Const FILE_BEGIN = 0
    12 Private Const INVALID_HANDLE_VALUE = -1
    13 Private 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
    14 Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
    15 Private 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
    16 Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
    17 Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    18 
    19 '调用:Call AppendToLog("测试模块名","测试日志内容")
    20 '**************************************
    21 ' 方法名称: AppendToLog
    22 ' 输入参数:sMdl 模块名称 sMessage 日志内容
    23 '**************************************
    24 Public Sub AppendToLog(sMdl As String, sMessage As String)
    25 
    26 On Error GoTo Err:
    27 
    28     '获取计算机名、用户名、本机ip
    29     Dim LocalInfo As String
    30     Dim strLocalIP As String
    31     Dim winIP As Object
    32     LocalInfo = LocalInfo & "  Computer:" & Environ("computername")
    33     LocalInfo = LocalInfo & "  User:" & Environ("username")
    34     Set winIP = CreateObject("MSWinsock.Winsock")
    35     strLocalIP = winIP.LocalIP
    36     LocalInfo = LocalInfo & "  IP:" & strLocalIP
    37 
    38     Dim lpFileName As String
    39     lpFileName = App.Path + "Log"
    40     If Dir(lpFileName, vbDirectory) = "" Then
    41         MkDir (lpFileName)
    42     End If
    43     
    44     lpFileName = lpFileName + "" + Format(Now, "yyyymmdd") + ".log"
    45     
    46     sMessage = "--" + Format(Now, "yyyy-mm-dd hh:mm:ss") + "  模块:" + sMdl + LocalInfo + vbNewLine + sMessage + vbNewLine
    47     'appends a string to a text file.
    48     'it's up to the coder to add a CR/LF at the end
    49     'of the string if (s)he so desires.
    50     'assume failure
    51     'AppendToLog = False
    52     'exit if the string cannot be written to disk
    53     If Len(sMessage) < 1 Then Exit Sub
    54     'get the size of the file (if it exists)
    55     Dim fLen As Long: fLen = 0
    56     If (Len(Dir(lpFileName))) Then: fLen = FileLen(lpFileName)
    57     'open the log file, create as necessary
    58     Dim hLogFile As Long
    59     hLogFile = CreateFile(lpFileName, GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, _
    60         IIf(Len(Dir(lpFileName)), OPEN_EXISTING, Create_NEW), _
    61         FILE_ATTRIBUTE_NORMAL, 0&)
    62     'ensure the log file was opened properly
    63     If (hLogFile = INVALID_HANDLE_VALUE) Then Exit Sub
    64     'move file pointer to end of file if file was not created
    65     If (fLen <> 0) Then
    66         If (SetFilePointer(hLogFile, fLen, ByVal 0&, FILE_BEGIN) = &HFFFFFFFF) Then
    67             'exit sub if the pointer did not set correctly
    68             CloseHandle (hLogFile)
    69             Exit Sub
    70         End If
    71     End If
    72     'convert the source string to a byte array for use with WriteFile
    73     Dim lTemp As Long
    74     ReDim TempArray(0 To Len(sMessage) - 1) As Byte
    75     TempArray = StrConv(sMessage, vbFromUnicode)
    76     lTemp = UBound(TempArray) + 1
    77     'write the string to the log file
    78     If (WriteFile(hLogFile, TempArray(0), lTemp, lTemp, ByVal 0&) <> 0) Then
    79         'the data was written correctly
    80         'AppendToLog = True
    81     End If
    82     'flush buffers and close the file
    83     FlushFileBuffers (hLogFile)
    84     CloseHandle (hLogFile)
    85     Exit Sub
    86 Err:
    87     MsgBox "日志写入出错,原因是" + Err.Description, vbExclamation, "提示信息"
    88     
    89 End Sub
  • 相关阅读:
    js绑定事件方法:addEventListener的兼容问题
    jQuery中$(function(){})与(function($){})(jQuery)、$(document).ready(function(){})等的区别讲解
    jQuery事件绑定函数:on()与bind()的差别
    click事件的累加绑定
    HTML标签marquee实现滚动效果
    原生js添加类名,删除类名
    CSS相邻兄弟选择器
    视差滚动
    纯js实现分页
    下拉加载更多内容(滚动加载)
  • 原文地址:https://www.cnblogs.com/yhsc/p/3874332.html
Copyright © 2020-2023  润新知