?? rwi-ni.bas
字號:
Attribute VB_Name = "Module2"
Option Explicit
'/************************************************************/
'/* == 模塊說明 == */
'/* */
'/* 這個程序中有幾個功能能否得到正確的結果, 關鍵就在于聲 */
'/* 明方式是否正確。程序中對API的聲明語句中, 有三個API函數是 */
'/* 被注釋了的,它們分別和它上面的函數是相同的,只是參數類型 */
'/* 有所不同,請仔細閱讀。這三條被注釋了的聲明語句是VB中自帶 */
'/* 的API瀏覽器原始聲明,但這不能使我們程序中所有的語句都得到 */
'/* 正確的結果,于是我修改了它們的聲明方式。 */
'/* 2002.11.15 */
'/* ======================================================== */
'/* ★ 本站聲明 ★ */
'/* */
'/* 本站所寫的代碼中加上了大量的注釋信息,由于每個程序員 */
'/* 對VB的設置不盡相同,如果代碼(尤其是注釋部分)的顯示零亂無 */
'/* 順,請在VB的選項中將代碼字體設置為"Fixedsys"。 */
'/* */
'/* 作者不承諾該本例是解此類問題的唯一方案,只是為了演示 */
'/* 而作。 */
'/* */
'/* 如果您要轉摘本代碼,請保留原代碼中的所有內容,包括注 */
'/* 釋部分,以示對作者勞動的尊重,謝謝!如發現代碼有問題,可 */
'/* 與作者聯系。 */
'/* 本代碼作者:VB超市站長-宋耀武 */
'/* http://vbsupermarket.yeah.net */
'/* E-Mail: songyaowu0001@sohu.com */
'/* renhengsoft@hotmail.com */
'/************************************************************/
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'%% 注意下面被注釋的三個聲明語句與新的聲明有何不同 %%
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Public 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
Public Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As Any, ByVal lpFileName As String) As Long
'Public Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
Public 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 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 Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As Any, ByVal lpKeyName As Any, ByVal lpDefault As Any, ByVal lpReturnedString As Any, ByVal nSize As Long, ByVal lpFileName As String) As Long
'Public 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
'*******************************************
' 從*.ini文件中讀一個條目
'*******************************************
Public Function ReadProFileString(Section As String, Key As String, iniFile As String) As String
Dim X As Long, buff As String, i As Integer
buff = String(255, 0)
X = GetPrivateProfileString(Section, Key, "", buff, 255, iniFile)
ReadProFileString = Left(buff, X)
End Function
'*****************************************************
' 讀取*.ini文件中的所有項目
'=====================================================
' lpFilename - *.ini文件名
' SectionArry() - 存儲返回的項目
'=====================================================
' 函數返回數組的最大下標值。(數組最小下標值為0)
' 若沒有找到任何值則函數返回-1
'*****************************************************
Public Function GetPrivateProfileAllSection(SectionArry() As String, lpFileName As String) As Long
Dim s As String
Dim i, Max As Integer
s = Space(1024)
GetPrivateProfileString 0&, 0&, "", s, 1024, lpFileName
SectionArry = Split(s, Chr(0))
Max = UBound(SectionArry) - 2
If Max >= 0 Then
ReDim Preserve SectionArry(Max)
End If
GetPrivateProfileAllSection = Max
End Function
'***********************************************************************************
' 讀取*.ini文件中指定小節下的所有關鍵字和值,每個關鍵字和值在數組中的位置一一對應
'===================================================================================
' pFile - *.ini文件名
' KeyString - 小節名
' KeyArry() - 存儲返回的所有關鍵字
' ValueArry() - 存儲返回的所有鍵值
'===================================================================================
' 函數返回關鍵字和鍵值數組的最大下標值。(數組最小下標值為0)
'***********************************************************************************
Public Function GetPrivateProfileSectionKeyValue(SectionName As String, pFile As String, KeyArry() As String, ValueArry() As String) As Long
Dim TempStr As String
Dim i, j, Max As Integer
Dim Rcode As Integer
Dim StringArry() As String
Dim l As Long
TempStr = Space(32676)
l = GetPrivateProfileSection(SectionName, TempStr, 32676, pFile)
If l <> 0 Then
TempStr = RTrim$(TempStr)
TempStr = Replace(TempStr, "=", Chr(0))
StringArry = Split(TempStr, Chr(0))
Max = UBound(StringArry) - 2
Rcode = (Max - 1) / 2
ReDim KeyArry(Rcode)
ReDim ValueArry(Rcode)
j = 0
For i = 0 To Rcode
KeyArry(i) = StringArry(j)
j = j + 1
ValueArry(i) = StringArry(j)
j = j + 1
Next
Erase StringArry
Else
Rcode = -1
End If
GetPrivateProfileSectionKeyValue = Rcode
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -