🚀 go-pugleaf

$BCf@n2mN4$H?=$7$^$9!#(J

$B;d$bF1MM$N$3$H$GG:$s$G$*$j$^$7$?$,<!$N$h$&$J%3!<%I$G2r7h$9$k$3$H$,(J
$B$G$-$^$7$?!#$*;n$7$/$@$5$$!#J8;z2=$1$7$F$?$i$4$a$s$M!#(J

'$B%l%8%9%H%j$NCM$r<hF@$9$k$?$a$N#A#P#I!#(J
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
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
Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long

Public Function GetKeyValue(InDrvStr As String) As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'$B5!G=!'%M%C%H%o!<%/%Q%9$rI=$9J8;zNs$r<hF@$9$k!#(J
'$BLaCM!'%M%C%H%o!<%/%Q%9$rI=$9J8;zNs(J
'$B0z?t!'%I%i%$%VL>(J(A$B!A(JZ)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error GoTo Err_GetKeyValue
    
    Dim W_Ret As String
        
    Dim i As Long
    Dim W_rc As Long         
    Dim W_hKey As Long       
    Dim W_KeyValType As Long 
    Dim W_tmpVal As String   
    Dim W_KeyValSize As Long 
    Dim W_KeyVal As String
    
    Const W_KEY_ALL_ACCESS = &H2003F
    
    Const W_HKEY_USERS = &H80000003
    Const W_ERROR_SUCCESS = 0
    Const W_REG_SZ = 1   ' Unicode Null $BJ8;z$G=*$o$kJ8;zNs(J
    Const W_REG_DWORD = 4   
    
    Const W_RegPass = "\Network\Persistent\"   '$B%l%8%9%H%j%Q%9!#(J
    Const W_RegItem = "RemotePath"
    
    W_rc = RegOpenKeyEx(W_HKEY_USERS, PF_LoginName & W_RegPass & InDrvStr,
0, W_KEY_ALL_ACCESS, W_hKey)   

    If (W_rc <> W_ERROR_SUCCESS) Then GoTo Err_GetKeyValue   
    
    W_tmpVal = String$(1024, 0)   ' $BJQ?tNN0h$N3d$jEv$F(J
    W_KeyValSize = 1024           
    
    '------------------------------------------------------------
    ' Z<^=DX 70$BCM$r<hF@$7$^$9(J...
    '------------------------------------------------------------
    W_rc = RegQueryValueEx(W_hKey, W_RegItem, 0, W_KeyValType, W_tmpVal,
W_KeyValSize)    
                                            
    If (W_rc <> W_ERROR_SUCCESS) Then GoTo Err_GetKeyValue   

    W_tmpVal = Left(W_tmpVal, InStr(W_tmpVal, Chr(0)) - 1)   '
$BJ8;zNs$N1&B&$K$"$k(J Null $B$r<h$j=|$$$?J8;zNs$r<hF@$7$^$9!#(J
    
    Select Case W_KeyValType   
        Case W_REG_SZ   
            W_Ret = W_tmpVal   
        Case W_REG_DWORD  
            For i = Len(W_tmpVal) To 1 Step -1   
                W_KeyVal = W_KeyVal + Hex(Asc(Mid(W_tmpVal, i, 1)))   '
Char $B$4$H$KCM$r:n@.(J
            Next i
            W_Ret = format$("&h" + W_KeyVal)   ' Double Word $B$r(J String
$B$KJQ49(J
    End Select

Exit_GetKeyValue:
    GetKeyValue = W_Ret
    W_rc = RegCloseKey(W_hKey) 
    Exit Function

Err_GetKeyValue:
    W_Ret = ""
    'MsgBox Format(Err, "00000") & ":" & Error$
    Resume Exit_GetKeyValue

End Function



'$B%l%8%9%H%j$NCM$r<hF@$9$k$?$a$N#A#P#I!#(J
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA"
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long,
ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal
lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As
Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As
Long

Public Function PF_LoginName() As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'$B5!G=!'%m%0%$%sL>$r<hF@$9$k!#(J
'$BLaCM!'%f!<%6#I#D!"%(%i!<;~$O%V%i%s%/!#(J
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'On Error GoTo Err_PF_LoginName

    Dim W_Ret As String

    Dim res&
    Dim lpS As String
    Dim keyhandle&
    Dim lpV As String
    Dim reserved As Long
    Dim lpT As Long
    Dim lpcbD As Long
    Dim i As Integer
    Dim j As Integer
    Dim iLen As Integer
    Dim cBuf As String
    Dim cData As String
    Dim lpD(50) As Long    'lpD 
$BCm0U!'(JString$B$G@k8@$9$k$H!"#1(JBite$BL\!JJ8;z?t!K$r2u$90Y(JEXCEL$B$,Mn$A$k(J

    Const KEY_QUERY_VALUE = &H1
    Const KEY_ENUMERATE_SUB_KEYS = &H8
    Const KEY_NOTIFY = &H10
    Const Synchronize = &H100000
    Const READ_CONTROL = &H20000
    Const STANDARD_RIGHTS_READ = (READ_CONTROL)
    
    Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or
KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not Synchronize))
    Const HKEY_LOCAL_MACHINE = &H80000002
    Const HKEY_CURRENT_USER = &H80000001
    Const ERROR_SUCCESS = 0&

    cBuf = ""
    cData = ""
    lpS = "Network\Logon"
    
    '$B%-!<(J(lpS)$B$r;2>H%b!<%I(J(KEY_READ)$B$G%*!<%W%s$9$k(J
    res& = RegOpenKeyEx(HKEY_LOCAL_MACHINE, lpS, 0, KEY_READ, keyhandle)
    
    If res& <> ERROR_SUCCESS Then
      Exit Function
    End If
    lpV = "username"
    lpT = 1
    lpcbD = 199 '$BCM<u$1<h$j%P%C%U%!$N%5%$%:$r;XDj(J
                '$B$3$l0J>e$NCM$,F~$C$F$$$?$i%(%i!<(J(234)$B$,5"$C$F$/$k(J
    
    '$BL>A0(J(lpV)$B$N%G!<%?$rLd$$9g$o$;$k(J
    res& = RegQueryValueEx(keyhandle, lpV, reserved, lpT, lpD(0), lpcbD)
    If res& <> ERROR_SUCCESS Then
      Exit Function
    End If
    
    'MsgBox "lpT  =" & lpT       '$B%G!<%?%?%$%W$,F~$C$F$/$k(J
    'MsgBox "lpD(0)=" & lpD(0)   '$B%G!<%?$,F~$C$F$/$k(J
    'MsgBox "lpcbD=" & lpcbD     '$B%;%C%H$5$l$?%5%$%:$,F~$C$F$/$k(J
    
    '$B%-!<$r%/%m!<%:$9$k(J
    res& = RegCloseKey(keyhandle)
    
    'MsgBox "res=" & res
      
    '$B<hF@%G!<%?$N2C9)(J
    'long$B%?%$%W$r(JHEX$BI=<($G=gHV$r@0$($k(J
    For i = 0 To 49
        iLen = Len(Hex(lpD(i)))
        'MsgBox iLen
        If iLen > 0 And Hex(lpD(i)) <> "0" Then
            For j = iLen To 1 Step -2
                'MsgBox "data=" & Mid(Hex(lpD(i)), j - 1, 2)
                cBuf = cBuf & Mid(Hex(lpD(i)), j - 1, 2)
            Next j
        End If
    Next i
    
    iLen = Len(cBuf)
    
    'HEX$BI=<((J(ChrCode)$B$N%G!<%?$r(JASCII$BJ8;zNs$KJQ49(J
    For i = 1 To iLen Step 2
        cData = cData & Chr(Val("&h" & Mid(cBuf, i, 2)))
    Next i
    
    W_Ret = StrConv(cData, vbUpperCase)

Exit_PF_LoginName:
    PF_LoginName = W_Ret
    Exit Function

Err_PF_LoginName:
    W_Ret = ""
    MsgBox format(Err, "00000") & ":" & Error$
    Resume Exit_PF_LoginName
    
End Function




Kazuo Yamamoto <kazuo@finest.co.jp> wrote in article
<6eqdet$hcb$1@nn-tk002.ocn.ad.jp>...
> VB$B$G%M%C%H%o!<%/%I%i%$%VL>$r!I(J\\Server_Name\$B6&M-L>(J\$B%U%)%k%@!<L>(J\$B!I$G(J
> $B=jF@$7$?$$$N$G$9$,2?$+J}K!$,$"$k$G$7$g$&$+!)(J
> 
> $B$G$-$l$P%^%C%T%s%0$5$l$F$$$k%I%i%$%VL>$+$i%U%k%Q%9$GEO$9$H>e5-$N7A$G(J
> $B5"$C$F$/$l$P0lHV$$$$$N$G$9$,(J
> 
> 
> ===========================================================
> $B;3K\(J $B0lM:(J (kazuo@finest.co.jp)
>      $B3t<02q<R(J $B%U%!%$%M%9%H!&%+%s%Q%K!<(J
>      HP http://www.finest.co.jp
> 
> 
>