【open 读取注册表导出文件乱码】用命令行reg，很简单，一些API实在看不下去了

窗体.frmPrivate Sub Command1_Click()
  Dim a As String
  a = GetRegValue("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\RAS AutoDial\Default", "DefaultInternet")
  MsgBox a
End Sub模块.basPublic Function GetRegValue(KeyName As String, ValueName As String) As String
  Shell "cmd /c reg export """ & KeyName & """ """ & Environ("Temp") & "\RegInfo""", vbHide
  Open Environ("Temp") & "\RegInfo" For Input As #1
  Dim strLine As String
  Do While Not EOF(1)
    Line Input #1, strLine
    If Mid(strLine, 2, Len(ValueName)) = ValueName Then
      GetRegValue = Mid(strLine, Len(ValueName) + 4, Len(strLine) - Len(ValueName) - 5)
      Exit Do
    End If
  Loop
  Close #1
End Function
strLine = StrConv(strLine, vbUnicode)
strLine = StrConv(strLine, vbFromUnicode)
都乱码

解决方案 »

免费领取超大流量手机卡，每月29元包185G流量+100分钟通话, 中国电信官方发货

烦人的API已经滚了,又来了个倒霉的EOF。重复打开文件多次，在Do While Not EOF(1)处设置断点
监视表达式EOF(1)，果然时不时为真，导致什么都读不出来。怎么重置EOF(1)的值？不是关闭文件后就为False了？
Public Function GetRegValue(KeyName As String, ValueName As String) As String
  Dim lngPid As Long
  lngPid = Shell("cmd /c reg query """ & KeyName & """ /v " & ValueName & "|findstr ""DefaultInternet""" & ">""" & Environ("Temp") & "\RegInfo""", vbHide)
  Dim hProcess As Long
  Dim i As Integer
  Do Until hProcess = 0
    If i > 10 Then Exit Do
    DoEvents
    Sleep 20
    i = i + 1
    hProcess = OpenProcess(&H400, 0, lngPid)
  Loop

  Open Environ("Temp") & "\RegInfo" For Input As #1

  Dim strLine As String
  Do While Not EOF(1)
    Line Input #1, strLine
    If InStr(1, strLine, "DefaultInternet" & vbTab) <> 0 Then
      GetRegValue = Mid(strLine, 28)
      Exit Do
    End If
  Loop
  Close #1
End Function
EOF 函数
      返回一个 Integer，它包含 Boolean 值 True，表明已经到达为 Random 或顺序 Input 打开的文件的结尾。语法EOF(filenumber)必要的 filenumber 参数是一个 Integer，包含任何有效的文件号。说明使用 EOF 是为了避免因试图在文件结尾处进行输入而产生的错误。直到到达文件的结尾，EOF 函数都返回 False。对于为访问 Random 或 Binary 而打开的文件，直到最后一次执行的 Get 语句无法读出完整的记录时，EOF 都返回 False。对于为访问 Binary 而打开的文件，在 EOF 函数返回 True 之前，试图使用 Input 函数读出整个文件的任何尝试都会导致错误发生。在用 Input 函数读出二进制文件时，要用 LOF 和 Loc 函数来替换 EOF 函数，或者将 Get 函数与 EOF 函数配合使用。对于为 Output 打开的文件，EOF 总是返回 True。
文件中是有内容的，但是刚打开文件#1,EOF(1)就等于True了
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByRef phkResult As Long, ByRef lpdwDisposition As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As LongConst REG_SZ = 1                         ' Unicode nul terminated string
Const REG_EXPAND_SZ = 2                  ' Unicode nul terminated string
Const REG_DWORD = 4                      ' 32-bit number' Reg Create Type Values...
Const REG_OPTION_NON_VOLATILE = 0       ' Key is preserved when system is rebooted' Reg Key Security Options...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
Const KEY_EXECUTE = KEY_READ
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
                       KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
                       KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL

' Reg Key ROOT Types...
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004' Return Value...
Const ERROR_NONE = 0
Const ERROR_BADKEY = 2
Const ERROR_ACCESS_DENIED = 8
Const ERROR_SUCCESS = 0Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
End Type
Sub LoadResStrings(frm As Form)
  On Error Resume Next

  Dim ctl As Control
  Dim obj As Object

  'set the form's caption
  If IsNumeric(frm.Tag) Then
    frm.Caption = LoadResString(CInt(frm.Tag))
  End If

  For Each ctl In frm.Controls
    Err.Clear
    If TypeName(ctl) = "Menu" Then
      If IsNumeric(ctl.Caption) Then
        If Err = 0 Then
          ctl.Caption = LoadResString(CInt(ctl.Caption))
        End If
      End If
    ElseIf TypeName(ctl) = "TabStrip" Then
      For Each obj In ctl.Tabs
        Err.Clear
        If IsNumeric(obj.Tag) Then
          obj.Caption = LoadResString(CInt(obj.Tag))
        End If
        'check for a tooltip
        If IsNumeric(obj.ToolTipText) Then
          If Err = 0 Then
            obj.ToolTipText = LoadResString(CInt(obj.ToolTipText))
          End If
        End If
      Next
    ElseIf TypeName(ctl) = "Toolbar" Then
      For Each obj In ctl.Buttons
        Err.Clear
        If IsNumeric(obj.Tag) Then
          obj.ToolTipText = LoadResString(CInt(obj.Tag))
        End If
      Next
    ElseIf TypeName(ctl) = "ListView" Then
      For Each obj In ctl.ColumnHeaders
        Err.Clear
        If IsNumeric(obj.Tag) Then
          obj.Text = LoadResString(CInt(obj.Tag))
        End If
      Next
    Else
      If IsNumeric(ctl.Tag) Then
        If Err = 0 Then
          ctl.Caption = LoadResString(CInt(ctl.Tag))
        End If
      End If
      'check for a tooltip
      If IsNumeric(ctl.ToolTipText) Then
        If Err = 0 Then
          ctl.ToolTipText = LoadResString(CInt(ctl.ToolTipText))
        End If
      End If
    End If
  NextEnd SubPublic Function UpdateKey(KeyRoot As Long, KeyName As String, SubKeyName As String, SubKeyValue As String) As Boolean
    Dim rc As Long                                      ' Return Code
    Dim hKey As Long                                    ' Handle To A Registry Key
    Dim hDepth As Long                                  '
    Dim lpAttr As SECURITY_ATTRIBUTES                   ' Registry Security Type

    lpAttr.nLength = 50                                 ' Set Security Attributes To Defaults...
    lpAttr.lpSecurityDescriptor = 0                     ' ...
    lpAttr.bInheritHandle = True                        ' ...    rc = RegCreateKeyEx(KeyRoot, KeyName, _
                        0, REG_SZ, _
                        REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, _
                        hKey, hDepth)                   ' Create/Open //KeyRoot//KeyName

    If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError   ' Handle Errors...    If (SubKeyValue = "") Then SubKeyValue = " "        ' A Space Is Needed For RegSetValueEx() To Work...

    ' Create/Modify Key Value
    rc = RegSetValueEx(hKey, SubKeyName, _
                       0, REG_SZ, _
                       SubKeyValue, LenB(StrConv(SubKeyValue, vbFromUnicode)))

    If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError   ' Handle Error    rc = RegCloseKey(hKey)                              ' Close Key

    UpdateKey = True                                    ' Return Success
    Exit Function                                       ' Exit
CreateKeyError:
    UpdateKey = False                                   ' Set Error Return Code
    rc = RegCloseKey(hKey)                              ' Attempt To Close Key
End FunctionPublic Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String) As String
    Dim i As Long                                           ' Loop Counter
    Dim rc As Long                                          ' Return Code
    Dim hKey As Long                                        ' Handle To An Open Registry Key
    Dim hDepth As Long                                      '
    Dim sKeyVal As String
    Dim lKeyValType As Long                                 ' Data Type Of A Registry Key
    Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
    Dim KeyValSize As Long                                  ' Size Of Registry Key Variable

    rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key

    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...

    tmpVal = String$(1024, 0)                             ' Allocate Variable Space
    KeyValSize = 1024                                       ' Mark Variable Size

    rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
                         lKeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value

    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors

    tmpVal = Left$(tmpVal, InStr(tmpVal, Chr(0)) - 1)    Select Case lKeyValType                                  ' Search Data Types...
    Case REG_SZ, REG_EXPAND_SZ                              ' String Registry Key Data Type
        sKeyVal = tmpVal                                     ' Copy String Value
    Case REG_DWORD                                          ' Double Word Registry Key Data Type
        For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
            sKeyVal = sKeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
        Next
        sKeyVal = Format$("&h" + sKeyVal)                     ' Convert Double Word To String
    End Select

    GetKeyValue = sKeyVal                                   ' Return Value
    rc = RegCloseKey(hKey)                                  ' Close Registry Key
    Exit Function                                           ' Exit

GetKeyError:    ' Cleanup After An Error Has Occured...
    GetKeyValue = vbNullString                              ' Set Return Val To Empty String
    rc = RegCloseKey(hKey)                                  ' Close Registry Key
End Function
上面是VB IDE自带的代码，自己参考下。
那些api很烦的，光是复制看得都可怕，不过现在改成WMI了，引用一下几行代码就搞定
GetAllSettings 函数示例
本示例首先使用 SaveSetting 语句来建立 Windows注册区里 appname 应用程序的项目，然后再使用 GetAllSettings 函数来取得设置值并显示出来。请注意，应用程序名和 section 名称不能用 GetAllSettings 函数取得。最后，使用 DeleteSetting 语句将该应用程序项删除。' 用来保存 GetAllSettings 函数所返回之二维数组数据的变量
' 整型数是用来计数用。
Dim MySettings As Variant, intSettings As Integer
' 在注册区中添加设置值。
SaveSetting appname := "MyApp", section := "Startup", _
key := "Top", setting := 75
SaveSetting "MyApp","Startup", "Left", 50
' 取得输入项的设置值。
MySettings = GetAllSettings(appname := "MyApp", section := "Startup")
   For intSettings = LBound(MySettings, 1) To UBound(MySettings, 1)
      Debug.Print MySettings(intSettings, 0), MySettings(intSettings, 1)
   Next intSettings
DeleteSetting "MyApp", "Startup"
乱码,就将乱码的原因找出来.全世界都在使用API,别人都不乱码,你用起来乱码?这明显不会是API的问题吧,不然微软就完了.....就你同样的键值,我测试了一下,木有问题.以下是在立即窗口中的代码:? GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\RAS AutoDial\Default", "DefaultInternet")
网通ADSL
相应的模块是:http://www.m5home.com/bbs/forum.php?mod=viewthread&tid=422&extra=page%3D4如果用这个代码还乱码,就只有可能是你机器上的问题了!
老妈呀，你的模块我已经有了，发在Modest的帖子里面，很好用，不会乱码。
但我只是需要用到读取字符串键值的，照样子精简了下，居然不能用
老妈杀鸡焉用牛刀？问题是  open 文本文件 For Input As #1
刚打开，EOF(1)就等于True
但是文件中确实是有内容的。

【open 读取注册表导出文件 乱码】用命令行reg，很简单，一些API实在看不下去了

解决方案 »

【open 读取注册表导出文件乱码】用命令行reg，很简单，一些API实在看不下去了