modrwini.bas

Fix通用外接报表程序,读取fix中的实时数据 生成相关报表曲线

Attribute VB_Name = "RWini"
Option Explicit
'win.ini
Declare Function GetProfileInt Lib "kernel32" Alias "GetProfileIntA" _
(ByVal lpAppName As String, _
ByVal lpKeyName As String, _
ByVal nDefault As Long) As Long

Declare Function GetProfileSection Lib "kernel32" Alias "GetProfileSectionA" _
(ByVal lpAppName As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long) As Long

Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" _
(ByVal lpAppName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long) As Long

Declare Function WriteProfileSection Lib "kernel32" Alias "WriteProfileSectionA" _
(ByVal lpAppName As String, _
ByVal lpString As String) As Long

Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" _
(ByVal lpszSection As String, _
ByVal lpszKeyName As String, _
ByVal lpszString As String) As Long

'*.ini
Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" _
(ByVal lpApplicationName As String, _
ByVal lpKeyName As String, _
ByVal nDefault As Long, _
ByVal lpFileName As String) As Long

Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" _
(ByVal lpAppName As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long, _
ByVal lpFileName As String) As Long

Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long, _
ByVal lpFileName As String) As Long

Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" _
(ByVal lpAppName As String, _
ByVal lpString As String, _
ByVal lpFileName As String) As Long

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

Public Function rini(zd As String, vu As String, Optional ByVal fileName = "\setup.ini", Optional ByVal mm As Boolean = False) As String
    Dim s As String * 255
    Dim n As Integer
    
    n = GetPrivateProfileString(zd, vu, "", s, Len(s), App.path & fileName)
    If mm Then
        rini = mima(Left(s, n), 110)
    Else
        rini = Left(s, n)
    End If
End Function
Public Function wini(zd As String, vu As String, svu As String, Optional ByVal fileName = "\setup.ini", Optional ByVal mm As Boolean = False) As Boolean
    On Error GoTo err
    
    If mm Then svu = mima(svu, 110)
    
    WritePrivateProfileString zd, vu, svu, App.path & fileName
    wini = True
    Exit Function
err:
    wini = False
    'MsgBox "发生错误,设置文件不存在或无法写入!"
End Function


Public Function mima(strSource As String, MA) As String
    Dim i As Integer
    On Error GoTo ErrEnDeCode
    Dim x As Single
    Dim CHARNUM As Long, RANDOMINTEGER As Integer
    Dim SINGLECHAR As String * 1
    Dim strTmp As String
      
    If MA < 0 Then
        MA = MA * (-1)
    End If
      
    x = Rnd(-MA)
    For i = 1 To Len(strSource) Step 1 '取单字节内容
        SINGLECHAR = Mid(strSource, i, 1)
        CHARNUM = Asc(SINGLECHAR)
g:
        RANDOMINTEGER = Int(127 * Rnd)
        If RANDOMINTEGER < 30 Or RANDOMINTEGER > 100 Then
            GoTo g
        End If
        CHARNUM = CHARNUM Xor RANDOMINTEGER
        strTmp = strTmp & Chr(CHARNUM)
    Next
      
    mima = strTmp
    Exit Function
    
ErrEnDeCode:
        mima = ""
        MsgBox err.number & "\" & err.Description
End Function