VB 관련 Tips
이 페이지에서는, 내가 VB 그리고 프로그램을 했을 때의 약간의
테크닉등을 소개합니다.
대부분이, 실제 사용하고 있는 코드이기 때문에 코멘트가 적은 눈이라고 할까
전혀, 없습니다입니다(^^;
1. 프로그램의 2겹기동 금지
2. 패스 변경 상태 취득
3. 캐릭터 라인중의 파일명과 패스를 분리한다
4. ini 파일 1행 데이터의 절단 분리
5. 디렉토리내의 전파일 취득
6. 오리지날 슬라이더의 작성법
7. 커멘드 디렉토리 버튼(DolphinKick 애드 인(Add In)용)
8. 「\0」이후의 캐릭터 라인 잘라서 버림
8. 브라우저를 열어 URL 를 지정
10. CD 의 재생 방법
11.MP3 의 ID3 Tag v1 를 취득
12. MP3 의 ID3 Tag v1 의 기입
13. WAVE, MIDI 의 재생 방법
--------------------------------------------------------------------------------
1. 프로그램의 2겹기동 금지
'2겹기동 방지
If App.PrevInstance Then
End
End If
일람에
--------------------------------------------------------------------------------
2. 패스 변경 상태 취득
'---------------------------------------------------------
'함수：Function getMovePathStatus()
'기능：패스 변경 상태를 취득
'인수：orgPath : 변경전의 패스
' newPath : 변경 후의 패스
'반환값 : 0 = 패스 변경 없음
' 1 = 드라이브 변경
' 2 = 상 디렉토리에 이동
' 3 = 하 디렉토리에 이동
'---------------------------------------------------------
Function getMovePathStatus(orgPath As String, newPath As String) As Long
Dim strOrgDrv As String
Dim strNewDrv As String
'드라이브 취득
If Left(orgPath, 2) = "\\" Then
strOrgDrv = Mid(orgPath, 3, InStr(3, orgPath, "\") - 1)
Else
strOrgDrv = Left(orgPath, InStr(1, orgPath, "\") - 1)
End If
If Left(newPath, 2) = "\\" Then
strNewDrv = Mid(newPath, 3, InStr(3, newPath, "\") - 1)
Else
strNewDrv = Left(newPath, InStr(1, newPath, "\") - 1)
End If
'드라이브 이동
If strOrgDrv <> strNewDrv Then
getMovePathStatus = 1
Exit Function
End If
'디렉토리 이동
If Len(orgPath) > Len(newPath) Then
getMovePathStatus = 2
ElseIf Len(orgPath) < Len(newPath) Then
getMovePathStatus = 3
Else
getMovePathStatus = 0
End If
End Function
일람에
--------------------------------------------------------------------------------
3. 캐릭터 라인중의 파일명과 패스를 분리한다
'---------------------------------------------------------
'함수：Function strFilePath()
'기능：캐릭터 라인중의 파일명과 패스를 분리한다
'인수：Word : 풀 패스 캐릭터 라인
' rPath : 패스
' rFile : 파일명
'반환값 : 0 : 에러
' : 1 : 파일명만
' : 2 : 패스＋파일명
'---------------------------------------------------------
Function strFilePath(Word As String, rPath As String, rFile As String) As Long
Dim i As Long
Dim WordLen As Long
Dim work As String
Dim SplitPoint As Long
rPath = ""
rFile = ""
WordLen = Len(Word)
If WordLen = 0 Then
strFilePath = 0
Exit Function
End If
SplitPoint = InStr(1, Word, "\")
If SplitPoint = 0 Then
strFilePath = 1
rFile = Word
rPath = ""
Exit Function
End If
For i = 1 To WordLen
SplitPoint = InStr(i, Word, "\")
If SplitPoint = 0 Then
SplitPoint = i - 1
Exit For
End If
Next
If WordLen = SplitPoint Then
strFilePath = 0
Exit Function
End If
strFilePath = 2
rPath = Left(Word, SplitPoint - 1)
rFile = Mid(Word, SplitPoint + 1)
End Function
일람에
--------------------------------------------------------------------------------
4. ini 파일 1행 데이터의 절단 분리
'---------------------------------------------------------
'함수：Function iniGetData()
'기능：ini 파일 1행 데이터의 절단 분리
'인수：Word : ini 파일 1행독입캐릭터 라인
' rKey : 항목명
' rData : 치
' rComment : 코멘트
'반환값：성공(True)/실패(False)
'---------------------------------------------------------
Function iniGetData(Word As String, rKey As String, _
rData As String, rComment As String) As Long
Dim i As Long
Dim WordLen As Long
Dim work As String
Dim SplitPoint As Long
rKey = ""
rData = ""
rComment = ""
WordLen = Len(Word)
If WordLen = 0 Then
iniGetData = False
Exit Function
End If
SplitPoint = InStr(1, Word, "=")
If SplitPoint = 0 Then
iniGetData = False
Exit Function
End If
rKey = Trim(Left(Word, SplitPoint - 1))
work = Trim(Mid(Word, SplitPoint + 1))
SplitPoint = InStr(1, work, ";")
If SplitPoint = 0 Then
rData = Trim(work)
rComment = ""
iniGetData = True
Exit Function
Else
For i = SplitPoint - 1 To 1 Step -1
If Mid(work, i, 1) <> " " And Mid(work, i, 1) <> vbTab Then
rData = Trim(Left(work, i))
rComment = Mid(work, i + 1)
iniGetData = True
Exit Function
End If
Next
rData = ""
rComment = work
iniGetData = True
Exit Function
End If
End Function
일람에
--------------------------------------------------------------------------------
5. 디렉토리내의 전파일 취득
'디렉토리의 파일 취득
Function getDirList(iDir As String)
Dim FileSytemObject, FolderObject, FilesCollection, _
FoldersCollection, FileCol, FoldCol
Set FileSytemObject = CreateObject("Scripting.FileSystemObject")
Set FolderObject = FileSytemObject.GetFolder(iDir)
Set FilesCollection = FolderObject.Files
Set FoldersCollection = FolderObject.SubFolders
'파일명 취득
For Each FileCol In FilesCollection
MsgBox "iDir & "\" & FileCol.Name"
Next
'해방
Set FileCol = Nothing
Set FilesCollection = Nothing
'디렉토리의 재귀 검색
For Each FoldCol In FoldersCollection
Call getDirList(iDir & "\" & FoldCol.Name)
Next
'해방
Set FoldCol = Nothing
Set FoldersCollection = Nothing
Set FolderObject = Nothing
Set FileSytemObject = Nothing
End Function
일람에
--------------------------------------------------------------------------------
6. 오리지날 슬라이더의 작성법
예 :
(1) 최초로, 바가 되는 픽처 박스와
버튼용의 픽처 박스2개를 폼에 붙입니다.
(2) 다음에, 버튼의 이동 범위를 결정합니다(아래의 예에서는 100~1600)
(3) 아래로부터, 바, 버튼 1, 버튼 2가 되도록(듯이) 폼에 배치합니다.
(4) 버튼 2의 MouseDown 이벤트시에, 밀린 위치의 기억,
밀리고 있는 것을 나타내는 플래그를 세트, 버튼 2의 비표시를 실시합니다.
(5) 버튼 2의 MouseMove 이벤트시에, (4)그리고 기억한 위치를 바탕으로
버튼 1을 이동합니다.
(6) 버튼 2의 MouseUp 이벤트시에, 버튼 1의 Left 값을 버튼 2에
대입, 버튼 2의 표시, 버튼 압하중 플래그의 해제를 실시합니다.
Private Sub picVol_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
xx = X
yy = Y
mv = True
picVol.Visible = False
End Sub
Private Sub picVol_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If mv = True Then
If picVol.Left + X - xx <= 1600 And picVol.Left + X - xx >= 100 Then
picVol2.Left = picVol.Left + X - xx
ElseIf picVol.Left + X - xx > 1600 Then
picVol2.Left = 1600
Else
picVol2.Left = 100
End If
'Call setVolume
End If
End Sub
Private Sub picVol_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
picVol.Left = picVol2.Left
picVol.Visible = True
mv = False
End Sub
일람에
--------------------------------------------------------------------------------
7. 커멘드 디렉토리 버튼(DolphinKick 애드 인(Add In))
'DliphinKick 오브젝트
Dim WithEvents dkcom As DKCommand
Dim WithEvents dklist As DKListModel
'Dolphin Kick 의 디렉토리 이동
Private Sub dklist_OnDirectoryChanged(ByVal newDir As String, ByVal nPane As Long)
Dim CMD As String '커멘드 디렉토리명
'어플리케이션 디렉토리 이하의 디렉토리로부터 어플리케이션 디렉토리에 이동
If InStr(1, LCase(newDir), LCase(app.path & "\")) <> 0 Then
'커멘드 디렉토리명을 취득
CMD = Mid(newDir, Len(iniData.ConsolePath & "\") + 1)
'커멘드 디렉토리에 들어갈 수 없게 한다
dklist.CurrentDir = dkstat.dkCurDir(dklist.CurrentPane)
dklist.MoveCursorToName dklist.CurrentPane, dkstat.dkCurFile(dklist.CurrentPane)
Select Case CMD
Case "PLAY"
'재생 처리
Case "STOP"
'정지 처리
End Select
End If
End Sub
일람에
--------------------------------------------------------------------------------
8. 「\0」이후의 캐릭터 라인 잘라서 버림
'---------------------------------------------------------
'함수：Function NTrim()
'기능：\0 이후의 캐릭터 라인 삭제
'인수：Word : 변환 모토후미자열
'반환값：변환 후 캐릭터 라인
'---------------------------------------------------------
Function NTrim(Word As String) As String
If InStr(Word, Chr(0)) > 0 Then
NTrim = Left(Word, InStr(Word, Chr(0)) - 1)
Else
NTrim = Word
End If
End Function
일람에
--------------------------------------------------------------------------------
9. 브라우저를 열어 URL 를 지정
'데스크탑 윈도우의 핸들 취득
Public Declare Function GetDesktopWindow Lib "user32" () As Long
'지정된 파일의 실행
Public Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Public Const SW_SHOW = 5
'---------------------------------------------------------
'함수：Function jumpUrl()
'기능：지정한 URL를 실행한다
'인수：sUrl : URL
'반환값：없음
'---------------------------------------------------------
Function jumpUrl(sUrl As String)
Dim lngAPIReVal As Long
'URL를 실행한다
lngAPIReVal = ShellExecute(GetDesktopWindow, "open", sUrl, vbNullString, "", SW_SHOW)
End Function
일람에
--------------------------------------------------------------------------------
10. CD 의 재생 방법 (MCI 공통 모듈을 사용합니다)
(1) 재생
Const Atype = "ATYPE"
Private Sub PlayCD()
'오픈
If mOpen("E:\Track01", Atype) <> 0 Then Exit Sub
Call mPlay(Atype) '재생
Call mTrack(1, Atype) '트럭 이동
End Sub
(2) 정지
Const Atype = "ATYPE"
Private Sub StopCD()
Call mStop(Atype) '정지
Call mClose(Atype) '클로우즈
End Sub
(3) 상태 취득
Const Atype = "ATYPE"
Private Sub getStatus()
Select Case Trim(mGetMode(Atype))
Case "stopped"
Debug.Print "정지중 "
Case "playing"
Debug.Print "재생중 "
Case "paused"
Debug.Print "일시정지중 "
Case Else
Debug.Print "정지중 "
Exit Select
End Select
(4) 지정 트럭의 길이 취득
Const Atype = "ATYPE"
Private Sub getTrackLen()
Dim FileFmt As String
Dim sec As Long
FileFmt = mGetTimeFormat(Atype) '현재의 타임 포맷 보존
Call mSetTimeFormat("milliseconds", Atype) '타임 포맷을 밀리 세컨드로 변경
sec = Val(mGetLengthTrack(Atype, 1)) / 1000 '트럭의 길이(초)를 취득
Call mSetTimeFormat(FileFmt, Atype) '타임 포맷을 바탕으로 되돌린다
End Sub
(5) 재생 위치 취득
Const Atype = "ATYPE"
Private Sub getPos()
Dim FileFmt As String
Dim sec As Long
FileFmt = mGetTimeFormat(Atype) '현재의 타임 포맷 보존
Call mSetTimeFormat("milliseconds", Atype) '타임 포맷을 밀리 세컨드로 변경
sec = Val(mGetPosition(Atype)) / 1000 'CD전체에서의 재생 위치 취득
'재생중 트럭의 위치를 취득해, 차이로부터 트럭내에서의 재생 위치를 취득
sec = sec - Val(mGetTrackPosition(Atype, mGetTrack(Atype))) / 1000
Call mSetTimeFormat(FileFmt, Atype) '타임 포맷을 바탕으로 되돌린다
End Sub
일람에
--------------------------------------------------------------------------------
11. MP3 의 ID3 Tag v1 를 취득(샘플의 다운로드)
Win32API 의 CreateFile, SetFilePointer, ReadFile, CloseHandle 의 함수를 사용합니다.
'선언부
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Public Declare Function SetFilePointer Lib "kernel32" _
(ByVal hFile As Long, _
ByVal lDistanceToMove As Long, _
ByVal lpDistanceToMoveHigh As Long, _
ByVal dwMoveMethod As Long) As Long
Public Declare Function ReadFile Lib "kernel32" _
(ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Long) As Long
Public Const GENERIC_ALL = &H10000000
Public Const GENERIC_EXECUTE = &H20000000
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const OPEN_ALWAYS = 4
Public Const OPEN_EXISTING = 3
Public Const INVALID_HANDLE_VALUE = &HFFFFFFFF
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_BEGIN = 0
Public Const FILE_END = 2
Public Type TAG_INFO
szTag As String 'TAG
szTrackName As String '곡명
szArtistName As String '아티스트명
szAlbumName As String '앨범명
szYear As String '릴리스 연호
szComment As String '코멘트
genre As Long '장르
End Type
Public Type TAG_DATA
szTag(3) As Byte 'TAG
szTrackName(30) As Byte '곡명
szArtistName(30) As Byte '아티스트명
szAlbumName(30) As Byte '앨범명
szYear(4) As Byte '릴리스 연호
szComment(30) As Byte '코멘트
genre As Long '장르
End Type
'태그 읽기
Private Sub cmdOpen_Click()
Dim lngFileHandle As Long
Dim Result As Long
Dim byteRead As Long
Dim iFile As String
Dim tagInfo As TAG_INFO
Dim tagData As TAG_DATA
Dim buf(128) As Byte
Dim i As Long
'초기화
txtTrackName.Text = ""
txtAirtist.Text = ""
txtAlubm.Text = ""
txtYear.Text = ""
txtComment.Text = ""
txtGenre.Text = ""
iFile = txtFileName.Text
If Trim(iFile) = "" Then Exit Sub
'파일 오픈
lngFileHandle = CreateFile(iFile, GENERIC_READ, FILE_SHARE_READ + FILE_SHARE_WRITE, _
0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
If lngFileHandle = INVALID_HANDLE_VALUE Then
Exit Sub
End If
'포인터를 태그 위치에 이동
Result = SetFilePointer(lngFileHandle, -128&, 0, FILE_END)
'태그 읽어들여
Result = ReadFile(lngFileHandle, buf(0), 128, byteRead, 0)
If Result = 0 Or byteRead <> 128 Then
'파일 클로우즈
Call CloseHandle(lngFileHandle)
Exit Sub
End If
'태그 정보의 절단 분리
With tagData
For i = 0 To 2
.szTag(i) = buf(i)
Next i
For i = 3 To 32
.szTrackName(i - 3) = buf(i)
Next i
For i = 33 To 62
.szArtistName(i - 33) = buf(i)
Next i
For i = 63 To 92
.szAlbumName(i - 63) = buf(i)
Next i
For i = 93 To 96
.szYear(i - 93) = buf(i)
Next i
For i = 97 To 126
.szComment(i - 97) = buf(i)
Next i
.genre = buf(127)
End With
'태그 정보를 Unicode 에 변환
tagInfo.szTag = Trim(NTrim(StrConv(tagData.szTag(), vbUnicode)))
tagInfo.szTrackName = Trim(NTrim(StrConv(tagData.szTrackName(), vbUnicode)))
tagInfo.szArtistName = Trim(NTrim(StrConv(tagData.szArtistName(), vbUnicode)))
tagInfo.szAlbumName = Trim(NTrim(StrConv(tagData.szAlbumName(), vbUnicode)))
tagInfo.szYear = Trim(NTrim(StrConv(tagData.szYear(), vbUnicode)))
tagInfo.szComment = Trim(NTrim(StrConv(tagData.szComment(), vbUnicode)))
tagInfo.genre = tagData.genre
If tagInfo.szTag = "TAG" Then
txtTrackName.Text = tagInfo.szTrackName
txtAirtist.Text = tagInfo.szArtistName
txtAlubm.Text = tagInfo.szAlbumName
txtYear.Text = tagInfo.szYear
txtComment.Text = tagInfo.szComment
txtGenre.Text = tagInfo.genre
End If
'파일 클로우즈
Call CloseHandle(lngFileHandle)
End Sub
일람에
--------------------------------------------------------------------------------
12. MP3 의 ID3 Tag v1 의 기입 (샘플의 다운로드)
Win32API 의 CreateFile, SetFilePointer, ReadFile, CloseHandle, WriteFile 의 함수를 사용합니다.
'선언부
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Public Declare Function SetFilePointer Lib "kernel32" _
(ByVal hFile As Long, _
ByVal lDistanceToMove As Long, _
ByVal lpDistanceToMoveHigh As Long, _
ByVal dwMoveMethod As Long) As Long
Public Declare Function ReadFile Lib "kernel32" _
(ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Long) As Long
Public Declare Function WriteFile Lib "kernel32" _
(ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As Long, _
ByVal lpOverlapped As Long) As Long
Public Const GENERIC_ALL = &H10000000
Public Const GENERIC_EXECUTE = &H20000000
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const OPEN_ALWAYS = 4
Public Const OPEN_EXISTING = 3
Public Const INVALID_HANDLE_VALUE = &HFFFFFFFF
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_BEGIN = 0
Public Const FILE_END = 2
Public Type TAG_INFO
szTag As String 'TAG
szTrackName As String '곡명
szArtistName As String '아티스트명
szAlbumName As String '앨범명
szYear As String '릴리스 연호
szComment As String '코멘트
genre As Long '장르
End Type
Public Type TAG_DATA
szTag(3) As Byte 'TAG
szTrackName(30) As Byte '곡명
szArtistName(30) As Byte '아티스트명
szAlbumName(30) As Byte '앨범명
szYear(4) As Byte '릴리스 연호
szComment(30) As Byte '코멘트
genre As Long '장르
End Type
'태그 기입
Private Sub cmdWrite_Click()
Dim lngFileHandle As Long
Dim Result As Long
Dim byteRead As Long
Dim iFile As String
Dim tagInfo As TAG_INFO
Dim tagData As TAG_DATA
Dim buf(128) As Byte
Dim i As Long
Dim inbuf(128) As Byte
Dim outbuf(128) As Byte
Dim strLen As Long
iFile = txtFileName.Text
If Trim(iFile) = "" Then Exit Sub
'파일 오픈
lngFileHandle = CreateFile(iFile, GENERIC_READ + GENERIC_WRITE, FILE_SHARE_READ, _
0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
If lngFileHandle = INVALID_HANDLE_VALUE Then
Exit Sub
End If
'----------------- 기입 준비 -------------------
'캐릭터 라인의 빈 곳을 스페이스에서 묻는다
strLen = LenB(StrConv(txtTrackName.Text, vbFromUnicode))
If strLen < 30 Then
txtTrackName.Text = txtTrackName.Text + Space(30 - strLen)
ElseIf strLen > 30 Then
txtTrackName.Text = Left(txtTrackName.Text, 30)
End If
strLen = LenB(StrConv(txtAirtist.Text, vbFromUnicode))
If strLen < 30 Then
txtAirtist.Text = txtAirtist.Text + Space(30 - strLen)
ElseIf strLen > 30 Then
txtAirtist.Text = Left(txtAirtist.Text, 30)
End If
strLen = LenB(StrConv(txtAlubm.Text, vbFromUnicode))
If strLen < 30 Then
txtAlubm.Text = txtAlubm.Text + Space(30 - strLen)
ElseIf strLen > 30 Then
txtAlubm.Text = Left(txtAlubm.Text, 30)
End If
strLen = LenB(StrConv(txtYear.Text, vbFromUnicode))
If strLen < 4 Then
txtYear.Text = txtYear.Text + Space(4 - strLen)
ElseIf strLen > 4 Then
txtYear.Text = Left(txtYear.Text, 30)
End If
strLen = LenB(StrConv(txtComment.Text, vbFromUnicode))
If strLen < 30 Then
txtComment.Text = txtComment.Text + Space(30 - strLen)
ElseIf strLen > 30 Then
txtComment.Text = Left(txtComment.Text, 30)
End If
'시스템 규정의 코드에 변환
tagInfo.szTag = StrConv("TAG", vbFromUnicode)
tagInfo.szTrackName = StrConv(txtTrackName.Text, vbFromUnicode)
tagInfo.szArtistName = StrConv(txtAirtist.Text, vbFromUnicode)
tagInfo.szAlbumName = StrConv(txtAlubm.Text, vbFromUnicode)
tagInfo.szYear = StrConv(txtYear.Text, vbFromUnicode)
tagInfo.szComment = StrConv(txtComment.Text, vbFromUnicode)
tagInfo.genre = Val(txtGenre.Text)
'기입 버퍼에 추가
With tagInfo
For i = 0 To 2
inbuf(i) = AscB(MidB(.szTag, i + 1, 1))
Next i
For i = 3 To 32
inbuf(i) = AscB(MidB(.szTrackName, i + 1 - 3, 1))
Next i
For i = 33 To 62
inbuf(i) = AscB(MidB(.szArtistName, i + 1 - 33, 1))
Next i
For i = 63 To 92
inbuf(i) = AscB(MidB(.szAlbumName, i + 1 - 63, 1))
Next i
For i = 93 To 96
inbuf(i) = AscB(MidB(.szYear, i + 1 - 93, 1))
Next i
For i = 97 To 126
inbuf(i) = AscB(MidB(.szComment, i + 1 - 97, 1))
Next i
inbuf(127) = .genre
End With
'----------------- ID3 Tag v1 존재 체크 -------------------
'포인터를 태그 위치에 이동
Result = SetFilePointer(lngFileHandle, -128&, 0, FILE_END)
'태그 읽어들여
Result = ReadFile(lngFileHandle, outbuf(0), 128, byteRead, 0)
If Result = 0 Or byteRead <> 128 Then
'파일 클로우즈
Call CloseHandle(lngFileHandle)
Exit Sub
End If
For i = 0 To 2
tagData.szTag(i) = outbuf(i)
Next i
'태그 정보를 Unicode 에 변환
tagInfo.szTag = Trim(NTrim(StrConv(tagData.szTag(), vbUnicode)))
'태그의 갱신
If tagInfo.szTag = "TAG" Then
'포인터를 태그 위치에 이동
Result = SetFilePointer(lngFileHandle, -128&, 0, FILE_END)
'태그 기입
Result = WriteFile(lngFileHandle, inbuf(0), 128, byteRead, 0)
If Result = 0 Or byteRead <> 128 Then
'파일 클로우즈
Call CloseHandle(lngFileHandle)
Exit Sub
End If
'태그의 추가
Else
'포인터를 파일의 마지막에 이동
Result = SetFilePointer(lngFileHandle, 0&, 0, FILE_END)
'태그 기입
Result = WriteFile(lngFileHandle, inbuf(0), 128, byteRead, 0)
If Result = 0 Or byteRead <> 128 Then
'파일 클로우즈
Call CloseHandle(lngFileHandle)
Exit Sub
End If
End If
'파일 클로우즈
Call CloseHandle(lngFileHandle)
End Sub
일람에
--------------------------------------------------------------------------------
13. WAVE, MIDI 의 재생 방법 (MCI 공통 모듈을 사용합니다)
(1) 재생
Const Atype = "ATYPE"
Private Sub Play()
'오픈
If mOpen("c:\hoge.wav", Atype) <> 0 Then Exit Sub
Call mPlay(Atype) '재생
End Sub
(2) 정지
Const Atype = "ATYPE"
Private Sub Stop()
Call mStop(Atype) '정지
Call mClose(Atype) '클로우즈
End Sub
(3) 일시정지
Const Atype = "ATYPE"
Private Sub getStatus()
Call mPause(cAtype) '일시정지
End Select
(4) 일시정지 해제
Const Atype = "ATYPE"
Private Sub getStatus()
Call mResume(cAtype) '일시정지 해제
End Select
(5) 상태 취득
Const Atype = "ATYPE"
Private Sub getStatus()
Select Case Trim(mGetMode(Atype))
Case "stopped"
Debug.Print "정지중 "
Case "playing"
Debug.Print "재생중 "
Case "paused"
Debug.Print "일시정지중 "
Case Else
Debug.Print "정지중 "
Exit Select
End Select
(6) 재생 시간 취득
Const Atype = "ATYPE"
Private Sub getTotalSec()
Dim FileFmt As String
Dim sec As Long
FileFmt = mGetTimeFormat(Atype) '현재의 타임 포맷 보존
Call mSetTimeFormat("milliseconds", Atype) '타임 포맷을 밀리 세컨드로 변경
sec = Val(mGetLengthTrack(Atype, 1)) / 1000 '연주총시간(초)을 취득
Call mSetTimeFormat(FileFmt, Atype) '타임 포맷을 바탕으로 되돌린다
End Sub
(7) 재생 위치 취득
Const Atype = "ATYPE"
Private Sub getPos()
Dim FileFmt As String
Dim sec As Long
FileFmt = mGetTimeFormat(Atype) '현재의 타임 포맷 보존
Call mSetTimeFormat("milliseconds", Atype) '타임 포맷을 밀리 세컨드로 변경
sec = Val(mGetPosition(Atype, 1)) / 1000 '재생 위치(초)를 취득
Call mSetTimeFormat(FileFmt, Atype) '타임 포맷을 바탕으로 되돌린다
End Sub
|
|
