VB模块

WININET.Bas

夜的影子 — Sun, 21 Nov 2004 06:02:00 GMT

Attribute VB_Name = "modWinInet"
Option Explicit
Declare Function GetProcessHeap Lib "kernel32" () As Long
Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Public Const HEAP_ZERO_MEMORY = &H8
Public Const HEAP_GENERATE_EXCEPTIONS = &H4
Declare Sub CopyMemory1 Lib "kernel32" Alias "RtlMoveMemory" ( _
    hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Declare Sub CopyMemory2 Lib "kernel32" Alias "RtlMoveMemory" ( _
    hpvDest As Long, hpvSource As Any, ByVal cbCopy As Long)
Public Const MAX_PATH = 260
Public Const NO_ERROR = 0
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_OFFLINE = &H1000

Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

Public Const ERROR_NO_MORE_FILES = 18
'调用 FtpFindFirstFile()后在目录中连续查找
Public Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
    (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
'返回文件信息。放在 WIN32_FIND_DATA 结构中
Public Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
    (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, _
    lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long
'接收指定的文件并且在本地建立它
Public Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
    (ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _
    ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, _
    ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
'发送指定文件到服务器
Public Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
    (ByVal hFtpSession As Long, ByVal lpszLocalFile As String, _
    ByVal lpszRemoteFile As String, _
    ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
'设置服务器上当前的工作目录
Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
    (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
' Initializes an application's use of the Win32 Internet functions
'初始化 Win32 internet
Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
    (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
    ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
' User agent constant.
Public Const scUserAgent = "vb wininet"
' Use registry access settings.
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_OPEN_TYPE_DIRECT = 1
Public Const INTERNET_OPEN_TYPE_PROXY = 3
Public Const INTERNET_INVALID_PORT_NUMBER = 0
Public Const FTP_TRANSFER_TYPE_ASCII = &H1
Public Const FTP_TRANSFER_TYPE_BINARY = &H1
Public Const INTERNET_FLAG_PASSIVE = &H8000000
' Opens a HTTP session for a given site.
'打开一个FTP, HTTP, or Gopher 应用会话
Public Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
    (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, _
    ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, _
    ByVal lFlags As Long, ByVal lContext As Long) As Long
Public Const ERROR_INTERNET_EXTENDED_ERROR = 12003
Public Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" ( _
    lpdwError As Long, _
    ByVal lpszBuffer As String, _
    lpdwBufferLength As Long) As Boolean
' Number of the TCP/IP port on the server to connect to.
Public Const INTERNET_DEFAULT_FTP_PORT = 21
Public Const INTERNET_DEFAULT_GOPHER_PORT = 70
Public Const INTERNET_DEFAULT_HTTP_PORT = 80
Public Const INTERNET_DEFAULT_HTTPS_PORT = 443
Public Const INTERNET_DEFAULT_SOCKS_PORT = 1080
Public Const INTERNET_OPTION_CONNECT_TIMEOUT = 2
Public Const INTERNET_OPTION_RECEIVE_TIMEOUT = 6
Public Const INTERNET_OPTION_SEND_TIMEOUT = 5
Public Const INTERNET_OPTION_USERNAME = 28
Public Const INTERNET_OPTION_PASSWORD = 29
Public Const INTERNET_OPTION_PROXY_USERNAME = 43
Public Const INTERNET_OPTION_PROXY_PASSWORD = 44
' Type of service to access.
Public Const INTERNET_SERVICE_FTP = 1
Public Const INTERNET_SERVICE_GOPHER = 2
Public Const INTERNET_SERVICE_HTTP = 3
' Opens an HTTP request handle.
Public Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" _
    (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, _
    ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
' Brings the data across the wire even if it locally cached.
Public Const INTERNET_FLAG_RELOAD = &H80000000
Public Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Public Const INTERNET_FLAG_MULTIPART = &H200000
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
' Sends the specified request to the HTTP server.
Public Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal _
    hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As _
    String, ByVal lOptionalLength As Long) As Integer

' Queries for information about an HTTP request.
Public Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" _
    (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, _
    ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer
' The possible values for the lInfoLevel parameter include:
Public Const HTTP_QUERY_CONTENT_TYPE = 1
Public Const HTTP_QUERY_CONTENT_LENGTH = 5
Public Const HTTP_QUERY_EXPIRES = 10
Public Const HTTP_QUERY_LAST_MODIFIED = 11
Public Const HTTP_QUERY_PRAGMA = 17
Public Const HTTP_QUERY_VERSION = 18
Public Const HTTP_QUERY_STATUS_CODE = 19
Public Const HTTP_QUERY_STATUS_TEXT = 20
Public Const HTTP_QUERY_RAW_HEADERS = 21
Public Const HTTP_QUERY_RAW_HEADERS_CRLF = 22
Public Const HTTP_QUERY_FORWARDED = 30
Public Const HTTP_QUERY_SERVER = 37
Public Const HTTP_QUERY_USER_AGENT = 39
Public Const HTTP_QUERY_SET_COOKIE = 43
Public Const HTTP_QUERY_REQUEST_METHOD = 45
Public Const HTTP_STATUS_DENIED = 401
Public Const HTTP_STATUS_PROXY_AUTH_REQ = 407
' Add this flag to the about flags to get request header.
Public Const HTTP_QUERY_FLAG_REQUEST_HEADERS = &H80000000
Public Const HTTP_QUERY_FLAG_NUMBER = &H20000000
' Reads data from a handle opened by the HttpOpenRequest function.
Public Declare Function InternetReadFile Lib "wininet.dll" _
    (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, _
    lNumberOfBytesRead As Long) As Integer
Public Declare Function InternetWriteFile Lib "wininet.dll" _
    (ByVal hFile As Long, ByVal sBuffer As String, _
    ByVal lNumberOfBytesToRead As Long, _
    lNumberOfBytesRead As Long) As Integer
'打开服务器上的一个文件进行读写
Public Declare Function FtpOpenFile Lib "wininet.dll" Alias _
    "FtpOpenFileA" (ByVal hFtpSession As Long, _
    ByVal sFileName As String, ByVal lAccess As Long, _
    ByVal lFlags As Long, ByVal lContext As Long) As Long
'删除服务器上一个指定的文件
Public Declare Function FtpDeleteFile Lib "wininet.dll" _
    Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _
    ByVal lpszFileName As String) As Boolean
Public Declare Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" _
    (ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByVal lBufferLength As Long) As Integer
Public Declare Function InternetSetOptionStr Lib "wininet.dll" Alias "InternetSetOptionA" _
    (ByVal hInternet As Long, ByVal lOption As Long, ByVal sBuffer As String, ByVal lBufferLength As Long) As Integer
' Closes a single Internet handle or a subtree of Internet handles.
Public Declare Function InternetCloseHandle Lib "wininet.dll" _
    (ByVal hInet As Long) As Integer
' Queries an Internet option on the specified handle
Public Declare Function InternetQueryOption Lib "wininet.dll" Alias "InternetQueryOptionA" _
    (ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long) As Integer
' Returns the version number of Wininet.dll.
Public Const INTERNET_OPTION_VERSION = 40
' Contains the version number of the DLL that contains the Windows Internet
' functions (Wininet.dll). This structure is used when passing the
' INTERNET_OPTION_VERSION flag to the InternetQueryOption function.
Public Type tWinInetDLLVersion
    lMajorVersion As Long
    lMinorVersion As Long
End Type
' Adds one or more HTTP request headers to the HTTP request handle.
Public Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias "HttpAddRequestHeadersA" _
    (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, _
    ByVal lModifiers As Long) As Integer
' Flags to modify the semantics of this function. Can be a combination of these values:
' Adds the header only if it does not already exist; otherwise, an error is returned.
Public Const HTTP_ADDREQ_FLAG_ADD_IF_NEW = &H10000000
' Adds the header if it does not exist. Used with REPLACE.
Public Const HTTP_ADDREQ_FLAG_ADD = &H20000000
' Replaces or removes a header. If the header value is empty and the header is found,
' it is removed. If not empty, the header value is replaced
Public Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000

Base64加密类，刚下载的

夜的影子 — Fri, 05 Nov 2004 04:40:00 GMT

'把所有的字符，二进制数据转换为64个可打印字符
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "CBase64"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Private Const BASE64CHR As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
Private psBase64Chr(0 To 63) As String

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Any, ByVal cbCopy As Long)
Private Declare Sub ZeroMemory Lib "kernel32" Alias _
"RtlZeroMemory" (dest As Any, ByVal numBytes As Long)

'=============================================================================
'〖名　　称〗:DecodeBase64String
'〖作　　者〗:ttyp
'〖创建日期〗:2004-7-15 20:58:51
'〖备　　注〗:
'〖功　　能〗:解压BASE64字符串
'〖返　　回〗:
'〖参　　数〗:
'=============================================================================
Friend Function DecodeBase64String(str2Decode As String) As String

    Dim lPtr            As Long
    Dim iValue          As Integer
    Dim iLen            As Integer
    Dim iCtr            As Integer
    Dim Bits(1 To 4)    As Byte
    Dim strDecode       As String
    Dim str             As String
    Dim Output()        As Byte

    Dim iIndex          As Long


    Dim lFrom As Long
    Dim lTo As Long

    '//除去回车
    str = Replace(str2Decode, vbCrLf, "")

    '//每4个字符一组（4个字符表示3个字）
    For lPtr = 1 To Len(str) Step 4
        iLen = 4
        For iCtr = 0 To 3
            '//查找字符在BASE64字符串中的位置
            iValue = InStr(1, BASE64CHR, Mid$(str, lPtr + iCtr, 1), vbBinaryCompare)
            Select Case iValue 'A~Za~z0~9+/
                Case 1 To 64:
                    Bits(iCtr + 1) = iValue - 1
                Case 65         '=
                    iLen = iCtr
                    Exit For
                    '//没有发现
                Case 0: Exit Function
            End Select
        Next

        '//转换4个6比特数成为3个8比特数
        Bits(1) = Bits(1) * &H4 + (Bits(2) And &H30) \ &H10
        Bits(2) = (Bits(2) And &HF) * &H10 + (Bits(3) And &H3C) \ &H4
        Bits(3) = (Bits(3) And &H3) * &H40 + Bits(4)

        '//计算数组的起始位置
        lFrom = lTo
        lTo = lTo + (iLen - 1) - 1

        '//重新定义输出数组
        ReDim Preserve Output(0 To lTo)

        For iIndex = lFrom To lTo
            Output(iIndex) = Bits(iIndex - lFrom + 1)
        Next

        lTo = lTo + 1

    Next

DecodeBase64String = StrConv(Output, vbUnicode)

End Function

'=============================================================================
'〖名　　称〗:DecodeBase64Byte
'〖作　　者〗:ttyp
'〖创建日期〗:2004-7-18 21:07:44
'〖备　　注〗:
'〖功　　能〗:解压BASE64字符串为数组
'〖返　　回〗:
'〖参　　数〗:
'=============================================================================
Public Function DecodeBase64Byte(str2Decode As String) As Byte()

        lTo = lTo + 1

    Next

DecodeBase64Byte = Output

End Function

'=============================================================================
'〖名　　称〗:EncodeBase64Byte
'〖作　　者〗:ttyp
'〖创建日期〗:2004-7-15 21:39:17
'〖备　　注〗:
'〖功　　能〗:转换数组为BASE64的数组
'〖返　　回〗:
'〖参　　数〗:
'=============================================================================
Public Function EncodeBase64Byte(sValue() As Byte) As String

    Dim lCtr                As Long
    Dim lPtr                As Long
    Dim lLen                As Long
    Dim sEncoded            As String
    Dim Bits8(1 To 3)       As Byte
    Dim Bits6(1 To 4)       As Byte

    Dim i As Integer

'//获得3个字符
sValue = StrConv(str2Encode, vbFromUnicode)

    For lCtr = 1 To UBound(sValue) + 1 Step 3

        For i = 1 To 3
            If lCtr + i - 2 <= UBound(sValue) Then
                Bits8(i) = sValue(lCtr + i - 2)
                lLen = 3
            Else
                Bits8(i) = 0
                lLen = lLen - 1
            End If
        Next

        '//转换字符串为数组，然后转换为4个6位(0-63)
        Bits6(1) = (Bits8(1) And &HFC) \ 4
        Bits6(2) = (Bits8(1) And &H3) * &H10 + (Bits8(2) And &HF0) \ &H10
        Bits6(3) = (Bits8(2) And &HF) * 4 + (Bits8(3) And &HC0) \ &H40
        Bits6(4) = Bits8(3) And &H3F

        '//添加4个新字符
        For lPtr = 1 To lLen + 1
            sEncoded = sEncoded & psBase64Chr(Bits6(lPtr))
        Next

    '//不足4位，以=填充
    Select Case lLen + 1
        Case 2: sEncoded = sEncoded & "=="
        Case 3: sEncoded = sEncoded & "="
        Case 4:
    End Select

EncodeBase64Byte = sEncoded

End Function

'=============================================================================
'〖名　　称〗:EncodeBase64String
'〖作　　者〗:ttyp
'〖创建日期〗:2004-7-15 21:24:47
'〖备　　注〗:
'〖功　　能〗:转换字符串为BASE64字符串，转换3个8比特(0 to 255)的字符成为4个6比特(0 to 63),不足以=填充
'〖返　　回〗:
'〖参　　数〗:
'=============================================================================
Friend Function EncodeBase64String(str2Encode As String) As String

    Dim lCtr                As Long
    Dim lPtr                As Long
    Dim lLen                As Long
    Dim sValue()            As Byte
    Dim sEncoded            As String
    Dim Bits8(1 To 3)       As Byte
    Dim Bits6(1 To 4)       As Byte

    Dim i As Integer

'//获得3个字符
sValue = StrConv(str2Encode, vbFromUnicode)

        '//添加4个新字符
        For lPtr = 1 To lLen + 1
            sEncoded = sEncoded & psBase64Chr(Bits6(lPtr))
        Next

    '//不足4位，以=填充
    Select Case lLen + 1
        Case 2: sEncoded = sEncoded & "=="
        Case 3: sEncoded = sEncoded & "="
        Case 4:
    End Select

EncodeBase64String = sEncoded

End Function

Private Sub Class_Initialize()
    Dim iPtr    As Integer
    '/////////初始化 BASE64数组
    For iPtr = 0 To 63
        psBase64Chr(iPtr) = Mid$(BASE64CHR, iPtr + 1, 1)
    Next
End Sub

        lTo = lTo + 1

    Next

DecodeBase64String = StrConv(Output, vbUnicode)

End Function

        lTo = lTo + 1

    Next

DecodeBase64Byte = Output

End Function

'//获得3个字符
sValue = StrConv(str2Encode, vbFromUnicode)

        '//添加4个新字符
        For lPtr = 1 To lLen + 1
            sEncoded = sEncoded & psBase64Chr(Bits6(lPtr))
        Next

    '//不足4位，以=填充
    Select Case lLen + 1
        Case 2: sEncoded = sEncoded & "=="
        Case 3: sEncoded = sEncoded & "="
        Case 4:
    End Select

EncodeBase64Byte = sEncoded

End Function

'//获得3个字符
sValue = StrConv(str2Encode, vbFromUnicode)

        '//添加4个新字符
        For lPtr = 1 To lLen + 1
            sEncoded = sEncoded & psBase64Chr(Bits6(lPtr))
        Next

    '//不足4位，以=填充
    Select Case lLen + 1
        Case 2: sEncoded = sEncoded & "=="
        Case 3: sEncoded = sEncoded & "="
        Case 4:
    End Select

EncodeBase64String = sEncoded

End Function

Private Sub Class_Initialize()
    Dim iPtr    As Integer
    '/////////初始化 BASE64数组
    For iPtr = 0 To 63
        psBase64Chr(iPtr) = Mid$(BASE64CHR, iPtr + 1, 1)
    Next
End Sub

Ini操作的类，经常用的

夜的影子 — Fri, 05 Nov 2004 04:33:00 GMT

'本来是点睛工作室的BAS模块，我给封装成了类，也没有仔细研究，简单修改了一下，增加了两个删除的方法
'但是没有仔细测试,有知道的帮忙改改,谢谢~~~

Option Explicit
'点睛工作室（主页：llf.126.com）（E-Mail：llfhome@126.com）
Private Declare Function GetPrivateProfileString Lib "KERNEL32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As Any, ByVal lpKeyName As Any, ByVal lpDefault As Any, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "KERNEL32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function GetWindowsDirectory Lib "KERNEL32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function WritePrivateProfileSection Lib "KERNEL32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long

Private mvar路径文件名 As String
Private mvar分类 As String

Public Property Let 分类(ByVal vData As String)
mvar分类 = vData
End Property

Public Property Get 分类() As String
分类 = mvar分类
End Property

Public Property Let 路径文件名(ByVal vData As String)
mvar路径文件名 = vData
End Property

Public Property Get 路径文件名() As String
路径文件名 = mvar路径文件名
End Property

Private Function Api字符串还原(原字符串 As String) As String
    Dim 长度 As Long
    长度 = InStr(1, 原字符串, vbNullChar) - 1
    If 长度 < 0 Then
        Api字符串还原 = 原字符串
    Else
        Api字符串还原 = Left$(原字符串, 长度)
    End If
End Function

Public Function 属性读(属性 As String, Optional ByVal 分类名 As String = "", Optional ByVal 缺省值 As String = "") As String
    属性读 = Space(256)
    Dim length As Long
    Dim C As String

    If 分类名 = "" Then C = mvar分类 Else C = 分类名: mvar分类 = 分类名

    length = GetPrivateProfileString(C, 属性, 缺省值, 属性读, 255, mvar路径文件名)

    If length <> 0 Then 属性读 = Api字符串还原(属性读) Else 属性读 = 缺省值
End Function

Public Sub 属性写(属性 As String, ByVal 值 As String, Optional ByVal 分类名 As String = "")
    Dim C As String
    If 分类名 = "" Then C = mvar分类 Else C = 分类名: mvar分类 = 分类名

    If WritePrivateProfileString(C, 属性, 值, mvar路径文件名) = 0 Then Err.Raise vbObjectError + 3, , "INI模块.属性写.写入INI文件"
End Sub

Public Sub INISave窗口(窗口 As Form, Optional ByVal m分类名 As String = "SYSTEM")
   Dim sSaveKey As String
   Dim sSaveDefault As String
   On Error GoTo SaveError

With 窗口
   If Not (窗口.WindowState = vbMinimized) Then      '如果窗体没有最小化
      Call 属性写("Maximised", ((窗口.WindowState = vbMaximized) * -1), m分类名)
      If (窗口.WindowState <> vbMaximized) Then      '如果没有最大化
      Call 属性写("Left", .Left)                                   '键
      Call 属性写("Top", .Top)
      Call 属性写("Width", .Width)
      Call 属性写("Height", .Height)
      End If
   End If
   Exit Sub
End With
SaveError:                              '错误处理

End Sub

Public Sub INILoad窗口(窗口 As Form, Optional ByVal m分类名 As String = "SYSTEM")
Dim L As Single, T As Single, H As Single, W As Single, Win As Long
Win = 属性读("Maximised", m分类名)
If Win = 0 Then
L = 属性读("Left", , 0)
T = 属性读("Top", , 0)
W = 属性读("Width", , 300)
H = 属性读("Height", , 1000)
窗口.Move L, T, W, H
Else
窗口.WindowState = Win
End If

End Sub

Public Sub 删除属性(属性 As String, ByVal 分类名 As String) '删除键
Dim m_lLastReturnCode As Long
m_lLastReturnCode = WritePrivateProfileString(分类名, 属性, 0&, mvar路径文件名)
End Sub

Public Sub 删除小节(ByVal 分类名 As String) '删除小节
Dim m_lLastReturnCode As Long
m_lLastReturnCode = WritePrivateProfileString(分类名, 0&, 0&, mvar路径文件名)
End Sub