🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Thread View: fj.lang.visualbasic
5 messages
5 total messages Started by Kazuo Yamamoto Thu, 19 Mar 1998 00:00
[Q]:リモート名を所得する方法
#347
Author: Kazuo Yamamoto
Date: Thu, 19 Mar 1998 00:00
12 lines
1017 bytes
VBでネットワークドライブ名を”\\Server_Name\共有名\フォルダー名\”で
所得したいのですが何か方法があるでしょうか?

できればマッピングされているドライブ名からフルパスで渡すと上記の形で
帰ってくれば一番いいのですが


===========================================================
山本 一雄 (kazuo@finest.co.jp)
     株式会社 ファイネスト・カンパニー
     HP http://www.finest.co.jp
Re: [Q]: リモート名を所得する方法
#357
Author: Sato Masahiro
Date: Fri, 20 Mar 1998 00:00
14 lines
1143 bytes
In article <6eqdet$hcb$1@nn-tk002.ocn.ad.jp>, Kazuo Yamamoto wrote:
>VBでネットワークドライブ名を”\\Server_Name\共有名\フォルダー名\”で
>所得したいのですが何か方法があるでしょうか?

もし Windows NT 上でということなら、Win32 API の WNetGetUniversalName 
関数が、お望みのものかと思います。

Windows 95 上でならば、WNetEnumResource 関数などを使用して同様の事を
行う必要があるとの記述を、Knowledge Base で見た記憶があります。

-- 
Computer Institute of Japan, Ltd.
佐藤正宏 masahiro@cij.co.jp
Re: [Q]: リモート名を所得する方法
#364
Author: Kazuo Yamamoto
Date: Sat, 21 Mar 1998 00:00
41 lines
2373 bytes
Sato Masahiro wrote in message <6esjel$mnp$1@hawaii.ykhm.cij.co.jp>...
>In article <6eqdet$hcb$1@nn-tk002.ocn.ad.jp>, Kazuo Yamamoto wrote:
>>VBでネットワークドライブ名を”\\Server_Name\共有名\フォルダー名\”で
>>所得したいのですが何か方法があるでしょうか?
>
>もし Windows NT 上でということなら、Win32 API の WNetGetUniversalName
>関数が、お望みのものかと思います。
>
>Windows 95 上でならば、WNetEnumResource 関数などを使用して同様の事を
>行う必要があるとの記述を、Knowledge Base で見た記憶があります。
>
>--
>Computer Institute of Japan, Ltd.
>佐藤正宏 masahiro@cij.co.jp
>

返事のほうありがとう御座います。

APIはわかったのですが
Declare Function WNetGetUniversalName Lib "mpr" Alias
"WNetGetUniversalNameA" _
                                (ByVal lpLocalPath As String, _
                                 ByVal dwInfoLevel As Long, _
                                 lpBuffer As Any, _
                                 lpBufferSize As Long) _
                                 As Long

Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" _
                                (ByVal hEnum As Long, _
                                 lpcCount As Long, _
                                 lpBuffer As Any, _
                                 lpBufferSize As Long) _
                                 As Long

の使い方が資料が足りなくてわかりません。
どなたかわかる方いませんか
===========================================================
山本 一雄 (kazuo@finest.co.jp)
     株式会社 ファイネスト・カンパニー
     HP http://www.finest.co.jp
Re: [Q]:$B%j%b!<%HL>$r=jF@$9$kJ}K!(J
#369
Author: Masataka Nakagawa
Date: Mon, 23 Mar 1998 00:00
219 lines
7717 bytes
$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
> 
> 
> 
Re: [Q]: リモート名を所得する方法
#372
Author: Sato Masahiro
Date: Mon, 23 Mar 1998 00:00
99 lines
4000 bytes
#fj.lang.visualbasic と fj.os.ms-windows.programming にクロスポストします。

In article <6f022j$jeq$1@nn-tk002.ocn.ad.jp>, Kazuo Yamamoto wrote:
>APIはわかったのですが
>Declare Function WNetGetUniversalName Lib "mpr" Alias
(中略)
>Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" _
(中略)
>の使い方が資料が足りなくてわかりません。
>どなたかわかる方いませんか

とのことですが、やはり API 関数を使用する際には、何らかの資料を
そろえる方が確実かと思います。

使い方についてですが、簡単に述べるとすると、以下のように
なるでしょう。

まず、WNetGetUniversalName 関数の第三引数は、以下のユーザ定義型の
情報を受け取ります。

Type UNIVERSAL_NAME_INFO
	lpUniversalName As Long
	buf(100) As Byte
End Type

ここで、

Dim uni As UNIVERSAL_NAME_INFO
Dim BufSize As Long
BufSize = 100

という様に変数を用意して、

WNetGetUniversalName "x:\hogehoge", UNIVERSAL_NAME_INFO_LEVEL, uni, BufSize

とすることによって、求める UNC 名(「ネットワークドライブ名」の
ことです)の情報を取得できます。UNC 名は、uni.buf に格納され、格納位置の
アドレスは uni.lpUniversalName に格納されます。

そこで、Win32 API の lstrcpy 関数を利用して、Visual Basic の文字列変数に
結果を複製します。

Dim RemoteName As String * 100
lstrcpy RemoteName, lpUniversalName

ただし、lstrcpy の Declare 宣言中で、第二引数を Byval lpszSrc As Long と
します。

以上によって、変数 RemoteName に、求める UNC 名を取得できました。

WNetEnumResource 関数の使用法も同様の手順に従います。まず、
WNetOpenEnum 関数によって列挙ハンドルをオープンします。

WNetOpenEnum RESOURCE_REMEMBERD, RESOURCETYPE_DISK, _
	RESOURCEUSAGE_CONNECTABLE, vbNullString, hEnum

あとは、例えば ERROR_NO_MORE_ITEMS が返されるまで WNetEnumResource 関数を
繰り返し実行することにより、記憶されている接続のローカル名と UNC 名を
次々と取得できます。

Entries = 1
BufSize = 1000
r = WNetEnumResource(hEnum, Entries, nr, BufSize)

ここで、変数 nr は以下のユーザ定義型の変数です。

Type NETRESOURCE
	dwScope As Long
	dwType As Long
	dwDisplayType As Long
	dwUsage As Long
	lpLocalName As Long
	lpRemoteName As Long
	lpComment As Long
	lpProvider As Long
	buf(1000) as Byte
End Type

WNetGetUniversalName の時と同様に、lpLocalName と lpRemoteName にそれぞれ
ローカル名と UNC 名の格納位置のアドレスが代入されます。

あとは、調べるローカル名と、列挙された nr.lpLocalName を比較して、
一致した時の nr.lpRemoteName が、求める UNC 名です。

If lstrcmp(LocalName, nr.lpLocalName) = 0 Then
	lstrcpy RemoteName, nr.lpRemoteName
	MsgBox RemoteName
End If

ただし、上記で、lstrcmp は、lstrcpy と同様に第二引数を値渡しの Long 型に
します。

なお、現在 Visual Basic を動かすことのできる環境にないため、
記述したコードが正しく動くかどうか、確認していませんのでご注意ください。

-- 
Computer Institute of Japan, Ltd.
佐藤正宏 masahiro@cij.co.jp
Thread Navigation

This is a paginated view of messages in the thread with full content displayed inline.

Messages are displayed in chronological order, with the original post highlighted in green.

Use pagination controls to navigate through all messages in large threads.

Back to All Threads