この VB6 コードの目的は、現在再生中の WinAmp のファイル名 (タイトルではない) を返すことです。
これは、VBNET に変換する必要がある行です。
Temp = StrConv(Buffer, vbUnicode)
strFileName = Left$(Temp, InStr(Temp, Chr$(0)) - 1)
Buffer は Byte 型、temp と strFileName は文字列型です。
ここもまた:
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As Byte, ByVal nSize As Long, ByRef lpNumberOfBytesRead As Long) As Long
...「ByRef lpBuffer As Any」を「ByRef lpBuffer As Byte」に変更しました (正しい変更を行ったと思います)。
これは完全なコードです:
Public Class Form1
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpszClassName As String, ByVal lpszWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, ByRef lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As Byte, ByVal nSize As Long, ByRef lpNumberOfBytesRead As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const PROCESS_VM_READ As Long = &H10
Private Const WM_USER As Long = &H400
Private Const IPC_GETPLAYLISTFILE As Long = 211
Private Const IPC_GETLISTPOS As Long = 125
Private Const MAX_PATH As Long = 260
Private hWndWinamp As Long
Private Function GetWinampWindow() As Long
GetWinampWindow = FindWindow("Winamp v1.x", vbNullString)
End Function
Public Function GetPlayingFileName() As String
Dim strFileName As String
Dim lp As Long, lpWinamp As Long
Dim iIndex As Long
Dim PID As Long
Dim bRet As Long
Dim dwRead As Long
Dim Buffer(MAX_PATH) As Byte
Dim Temp As String
hWndWinamp = GetWinampWindow
If hWndWinamp = 0 Then
GetPlayingFileName = ""
Exit Function
End If
iIndex = SendMessage(hWndWinamp, WM_USER, 0, IPC_GETLISTPOS)
lp = SendMessage(hWndWinamp, WM_USER, iIndex, IPC_GETPLAYLISTFILE)
If lp = 0 Then
GetPlayingFileName = ""
Exit Function
End If
Call GetWindowThreadProcessId(hWndWinamp, PID)
lpWinamp = OpenProcess(PROCESS_VM_READ, 0, PID)
If lpWinamp = 0 Then
GetPlayingFileName = ""
Exit Function
End If
bRet = ReadProcessMemory(lpWinamp, lp, Buffer(0), MAX_PATH, dwRead)
Call CloseHandle(lpWinamp)
Temp = StrConv(Buffer, vbUnicode)
strFileName = Left$(Temp, InStr(Temp, Chr$(0)) - 1)
GetPlayingFileName = strFileName
End Function
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
MsgBox(GetPlayingFileName())
End Sub
End Class
アップデート
これは提案に従って更新されたコードですが、try/catch 行で次のエラーで失敗しています: STARTINDEX CANNOT BE LESS THAN ZERO
Public Class Form1
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpszClassName As String, ByVal lpszWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, ByRef lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As Byte, ByVal nSize As Long, ByRef lpNumberOfBytesRead As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const PROCESS_VM_READ As Long = &H10
Private Const WM_USER As Long = &H400
Private Const IPC_GETPLAYLISTFILE As Long = 211
Private Const IPC_GETLISTPOS As Long = 125
Private Const MAX_PATH As Long = 260
Private hWndWinamp As Long
Private Function GetWinampWindow() As Long
GetWinampWindow = FindWindow("Winamp v1.x", vbNullString)
End Function
Public Function GetPlayingFileName() As String
Dim strFileName As String
Dim lp As Long, lpWinamp As Long
Dim iIndex As Long
Dim PID As Long
Dim bRet As Long
Dim dwRead As Long
Dim Buffer(MAX_PATH) As Byte
Dim Temp As String
hWndWinamp = GetWinampWindow()
If hWndWinamp = 0 Then
GetPlayingFileName = ""
Exit Function
End If
iIndex = SendMessage(hWndWinamp, WM_USER, 0, IPC_GETLISTPOS)
lp = SendMessage(hWndWinamp, WM_USER, iIndex, IPC_GETPLAYLISTFILE)
If lp = 0 Then
GetPlayingFileName = ""
Exit Function
End If
Call GetWindowThreadProcessId(hWndWinamp, PID)
lpWinamp = OpenProcess(PROCESS_VM_READ, 0, PID)
If lpWinamp = 0 Then
GetPlayingFileName = ""
Exit Function
End If
bRet = ReadProcessMemory(lpWinamp, lp, Buffer(0), MAX_PATH, dwRead)
Call CloseHandle(lpWinamp)
' Original VB6 code
'Temp = StrConv(Buffer, vbUnicode)
'strFileName = Left$(Temp, InStr(Temp, Chr$(0)) - 1)
Temp = System.Text.UnicodeEncoding.Unicode.GetString(Buffer)
Try
strFileName = Temp.Substring(Temp.IndexOf(CChar("0")) - 1)
Catch ex As Exception
MsgBox(ex.Message)
End Try
GetPlayingFileName = strFileName
End Function
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
MsgBox(GetPlayingFileName())
End Sub
End Class