> こんにちは。いつも拝見していますが初めてお世話になります。
> 早速ですが、WEBからLoadString()APIに相当すると思われる
> Ｃの下記サンプルを発見しました。勉強のため、これをＶＢに
> 変換しているのですが、Ｃの知識が乏しいためどうしても解から
> ない所（下記鎖線部）があります。
> そこをＶＢに変換するにはどのようにすれば宜しいのでしょうか？
う〜ん、これはきつかった。
５時間ぐらいかかった。
VBでポインタを使うとわけわからんようになる。
以下のソースを参考にしてください。
まだわからないところがあれば、書き込んでください。
Option Explicit
Private Const RT_STRING = 6&
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
'#define LANG_NEUTRAL 0x00
'#define SUBLANG_DEFAULT 0x01 // user default
Private Const LANG_NEUTRAL = 0
Private Const SUBLANG_DEFAULT = 1
Private Declare Function LoadString Lib "user32" Alias "LoadStringA" ( _
ByVal hInstance As Long, _
ByVal wID As Long, _
ByVal lpBuffer As String, _
ByVal nBufferMax As Long _
) As Long
Private Declare Function FindResourceExByNum Lib "kernel32" Alias "FindResourceExA" ( _
ByVal hModule As Long, _
ByVal lpType As Long, _
ByVal lpName As Long, _
ByVal wLanguage As Long _
) As Long
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" ( _
ByVal dwFlags As Long, _
lpSource As Any, _
ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, _
ByVal nSize As Long, _
Arguments As Long _
) As Long
Private Declare Function LoadResource Lib "kernel32" ( _
ByVal hInstance As Long, _
ByVal hResInfo As Long _
) As Long
Private Declare Function LockResource Lib "kernel32" ( _
ByVal hResData As Long _
) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Destination As Any, _
Source As Any, _
ByVal Length As Long _
)
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" ( _
ByVal lpLibFileName As String _
) As Long
Private Declare Function FreeLibrary Lib "kernel32" ( _
ByVal hLibModule As Long _
) As Long
'#define MAKELANGID(p, s) ((((WORD )(s)) << 10) | (WORD )(p))
Private Function MAKELANGID(p As Long, s As Long) As Long
MAKELANGID = ((s And &HFFFF&) * (2 ^ 10)) Or (p And &HFFFF&)
End Function
'#define LANG_USER_DEFAULT (MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT))
Private Function LANG_USER_DEFAULT() As Long
LANG_USER_DEFAULT = MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT)
End Function
Private Sub Command1_Click()
Dim sStr As String
Dim nBuf As Long
Dim hInst As Long
hInst = LoadLibrary("D:\Projects\Visual Basic 6.0\LoadStringEx\Project1.exe")
'hInst = App.hInstance
' nBuf = 256
' sStr = Space$(nBuf)
' Me.Print "ret : " & LoadString(hInst, 101, sStr, nBuf)
' Me.Print Left$(sStr, InStr(sStr, vbNullChar) - 1)
Me.Print "ret : [" & LoadStringEx(hInst, 101, LANG_USER_DEFAULT()) & "]"
Me.Print "ret : [" & LoadStringEx(hInst, 102, LANG_USER_DEFAULT()) & "]"
Me.Print "ret : [" & LoadStringEx(hInst, 201, LANG_USER_DEFAULT()) & "]"
Me.Print "ret : [" & LoadStringEx(hInst, 202, LANG_USER_DEFAULT()) & "]"
Me.Print "ret : [" & LoadStringEx(hInst, 203, LANG_USER_DEFAULT()) & "]"
Me.Print "ret : [" & LoadStringEx(hInst, 204, LANG_USER_DEFAULT()) & "]"
Call FreeLibrary(hInst)
End Sub
'VBに変換したコード（関数の引き数、戻り値を変更してます。）
Function LoadStringEx(hInstance As Long, uID As Long, wLanguage As Long) As String
Dim hGlb As Long
Dim hRsrc As Long
Dim strMsgBuf As String * 512 '(文字列型に変更)
Dim nBlock As Long
Dim nNum As Long
Dim ptrVal As Long
Dim I As Long
Dim nStrLen As Integer
Dim nRet As Long
nBlock = uID \ 16 + 1
nNum = uID And &HF&
Debug.Print "nBlock : " & nBlock
Debug.Print "nNum : " & nNum
hRsrc = FindResourceExByNum(hInstance, RT_STRING, nBlock, wLanguage)
If (hRsrc = 0) Then
Call FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or _
FORMAT_MESSAGE_IGNORE_INSERTS, _
ByVal 0&, Err.LastDllError, LANG_USER_DEFAULT(), _
strMsgBuf, Len(strMsgBuf), ByVal 0&)
Call MsgBox(Left$(strMsgBuf, InStr(strMsgBuf, vbNullChar) - 1), _
vbOKOnly Or vbInformation, "Error")
Exit Function
End If
hGlb = LoadResource(hInstance, hRsrc)
'---- ここから --------------------------------
ptrVal = LockResource(hGlb)
If ptrVal <> 0 Then
For I = 0 To nNum - 1
Call CopyMemory(nStrLen, ByVal ptrVal, 2)
ptrVal = ptrVal + 1 * 2
ptrVal = ptrVal + nStrLen * 2
Next
Call CopyMemory(nStrLen, ByVal ptrVal, 2)
ptrVal = ptrVal + 2
End If
'---- ここまで ---------------------------------------------
LoadStringEx = StrFromPtr(ptrVal, CLng(nStrLen))
End Function
Public Function StrFromPtr(lptr As Long, nSize As Long) As String
Dim sBuffer As String
ReDim yBuffer(512) As Byte
Call CopyMemory(yBuffer(0), ByVal lptr, 512)
sBuffer = yBuffer
StrFromPtr = Left$(sBuffer, nSize)
End Function
|