VB Sony Hifi bedienen Slink-e
Verfasst: 06.05.2008 09:19
Mit diesen Programm ist es möglich die CDP CX 450 von sony zu bedienen, und über internet einzulesen, CDDB daten bank aber das Programm ist nur für einen CDP CX235 vor gesehen.und ich möchte das das Programm den 400er auch Liest, dazu brauche ich hilfe.
Ich kann auch den Tuner und die Laustärke bedienen.
hier ist der code
Option Explicit
Public speich
Public mdanzahl
Public geraet
Public umwanderg
Public tocenn
Private b(10000)
Private a(10000)
Private player(1, 255, 2000)
Private playerzeit(1, 255, 2000)
Private playermore(1, 255, 10)
Private outpp
Private changcd
Private changezehn
Private suchergebnis(2, 10000)
Private fixspeichern
Private altesbild
Private dilan(280)
Private matrix(2, 260)
Private vergleich(1000)
Private cdform(256)
Private goofy
Private evigfile
Private gift
' ----------------------------------------------
' * MouseEvent Related Declares *
' ----------------------------------------------
Private Const MOUSEEVENTF_ABSOLUTE = &H8000
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
Private Const MOUSEEVENTF_MOVE = &H1
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, _
ByVal dx As Long, ByVal dy As Long, ByVal cbuttons As Long, _
ByVal dwExtraInfo As Long)
' ----------------------------------------------
' * GetSystemMetrics Related Declares *
' ----------------------------------------------
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Const TWIPS_PER_INCH = 1440
Private Const POINTS_PER_INCH = 72
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex _
As Long) As Long
' ----------------------------------------------
' * GetWindowRect Related Declares *
' ----------------------------------------------
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
lpRect As RECT) As Long
' ----------------------------------------------
' * Internal Constants and Types *
' ----------------------------------------------
Private Const MOUSE_MICKEYS = 65535
Public Enum enReportStyle
rsPixels
rsTwips
rsInches
rsPoints
End Enum
Public Enum enButtonToClick
btcLeft
btcRight
btcMiddle
End Enum
Public jetzt
Public pfad
Dim isReg As Boolean
Rem Dim ops As c1.CddbOptions
Dim ops As CddbOptions
Dim proxy As Variant
' Returns the screen size in pixels or, optionally,
' in others scalemode styles
Public Sub GetScreenRes(ByRef X As Long, ByRef Y As Long, Optional ByVal _
ReportStyle As enReportStyle)
X = GetSystemMetrics(SM_CXSCREEN)
Y = GetSystemMetrics(SM_CYSCREEN)
If Not IsMissing(ReportStyle) Then
If ReportStyle <> rsPixels Then
X = X * Screen.TwipsPerPixelX
Y = Y * Screen.TwipsPerPixelY
If ReportStyle = rsInches Or ReportStyle = rsPoints Then
X = X \ TWIPS_PER_INCH
Y = Y \ TWIPS_PER_INCH
If ReportStyle = rsPoints Then
X = X * POINTS_PER_INCH
Y = Y * POINTS_PER_INCH
End If
End If
End If
End If
End Sub
Private Sub alltim()
Dim Min, sec, itt, itt1, fip As String
sami "81080547204400FF"
itt = ""
rauff:
datenholennn
itt1 = outpp
itt = itt + itt1
If Right(itt, 2) <> "FF" Then GoTo rauff:
itt = Right(itt,
Min = Right("000" + Mid(Str(Val("&H" + Mid(itt, 1, 2))), 2), 3)
sec = Right("00" + Mid(Str(Val("&H" + Mid(itt, 3, 2))), 2), 2)
fip = Min + ":" + sec
alltime.Text = fip
End Sub
Private Sub alltimess_click()
alltim
End Sub
Private Sub restzeit()
Dim itt, itt1, Min, sec, fip As String
sami "81080547205400FF"
itt = ""
rauff:
datenholennn
itt1 = outpp
itt = itt + itt1
If Right(itt, 2) <> "FF" Then GoTo rauff:
itt = Right(itt, 6)
Min = Right("000" + Mid(Str(Val("&H" + Mid(itt, 1, 2))), 2), 3)
sec = Right("00" + Mid(Str(Val("&H" + Mid(itt, 3, 2))), 2), 2)
fip = Min + ":" + sec
resttime.Text = fip
End Sub
Private Sub auswerten_Click()
auswertenn
End Sub
Private Sub auswertenn()
Dim huha, restsec, restmin, restall, prosent As Long
Dim huhb, meinallessec, meinallesmin, meinalles, huhh As Long
alltim
restzeit
huha = Abs(Val(Mid(MDCAT.alltime.Text, 1, 3))) * 60 + Abs(Val(Right(MDCAT.alltime.Text, 2)))
huhb = Abs(Val(Right(MDCAT.resttime.Text, 2))) + 60 * Abs(Val(Mid(MDCAT.resttime.Text, 1, 3)))
huhh = huha + huhb
alltogether.Text = Mid(Str(Int(huhh / 60)), 2) + ":" + Right("00" + Mid(Str(huhh - (Int(huhh / 60) * 60)), 2, 2), 2)
meinalles = Val(Right(alltogether.Text, 2)) + 60 * Val(Mid(alltogether.Text, 1, 3))
meinallessec = Val(Right(alltogether.Text, 2))
meinallesmin = Val(Mid(alltogether.Text, 1, 3))
meinalles = meinallessec + meinallesmin * 60
restsec = Val(Right(MDCAT.resttime.Text, 2))
restmin = Val(Mid(MDCAT.resttime.Text, 1, 3))
restall = restsec + restmin * 60
prosent = Round((100 / meinalles * restall), 2)
prozentuel.Text = Str(prosent) + " %"
Image11.Width = Image10.Width / 100 * prosent
End Sub
Private Sub bilda()
Dim zoag As String
Image7.Visible = True
On Error GoTo nos:
zoag = playermore(0, MDCAT.cdlist.ListIndex, 2)
If altesbild <> zoag Then
Image7.Visible = True
Image9.Visible = False
If zoag = "" Then GoTo nos
Image7.Picture = LoadPicture(zoag)
altesbild = zoag
GoTo hiob:
End If
GoTo hiob:
nos:
Image7.Visible = False
Image9.Visible = True
hiob:
Rem playermore(0,2,2)
End Sub
Private Sub cdlist_Change()
Dim gaga As String
Dim tim As Integer
If geraet = "65" Then
cdlade.ListIndex = cdlist.ListIndex
gaga = playermore(0, cdlade.ListIndex, 1)
MDtitel.Clear
zeitlist.Clear
inindex.Clear
Rem mdcdname.Text = playermore(0, cdlade.ListIndex, 4) + " - " + playermore(0, cdlade.ListIndex, 3)
mdcdname.Text = playermore(0, cdlade.ListIndex, 4)
MDCAT.cdautor = playermore(0, cdlade.ListIndex, 3)
mdcode.Text = Right("000" + Mid(Str(cdlade.ListIndex + 1), 2), 3)
Cdandsinger.Text = playermore(0, cdlade.ListIndex, 2)
For tim = 1 To gaga
MDtitel.AddItem player(0, cdlade.ListIndex, tim)
zeitlist.AddItem playerzeit(0, cdlade.ListIndex, tim)
inindex.AddItem Right("00" + Mid(Str(tim), 2), 3)
Next
If geraet = "71" Then
cdlade.ListIndex = cdlist.ListIndex
gaga = playermore(1, cdlade.ListIndex, 1)
MDtitel.Clear
zeitlist.Clear
inindex.Clear
Rem mdcdname.Text = playermore(0, cdlade.ListIndex, 4) + " - " + playermore(0, cdlade.ListIndex, 3)
mdcdname.Text = playermore(1, cdlade.ListIndex, 4)
MDCAT.cdautor = playermore(1, cdlade.ListIndex, 3)
mdcode.Text = Right("000" + Mid(Str(cdlade.ListIndex + 1), 2), 3)
Cdandsinger.Text = playermore(0, cdlade.ListIndex, 2)
For tim = 1 To gaga
MDtitel.AddItem player(1, cdlade.ListIndex, tim)
zeitlist.AddItem playerzeit(1, cdlade.ListIndex, tim)
inindex.AddItem Right("00" + Mid(Str(tim), 2), 3)
Next
End If
bilda
End If
End Sub
Private Sub abspeichh_Click()
If geraet = "71" Then
If speich = 1 Then GoTo rueber:
Cds 2, &H2
Rem stop
Cds 2, &H2
Rem Zeiteneinlesen
refreshit
Rem Titel der MD anzeigen
titelermittelnn
Rem Zeitenangaben
auswertenn
Rem MD Titel einlesen
titeleinlesenn
speich = 1
rueber:
absp
End If
If geraet <> "71" Then
absp
End If
End Sub
Private Sub absp()
Dim cd, m, susi, yemen, ida, affe, ego, i As Long
Dim susi2, susi3, evelin, evelin1, toi, fip, sep, evelin2, spcode, spco, topm, tger As String
Rem t1.RichTextBox1.Text = ""
Rem t1.RichTextBox1.SaveFile "«CDMDcat»" + wert1 + ".doc", 1
m = MDCAT.cdlist.ListIndex
cd = 0
If geraet = "71" Then
cd = 1
m = Val(mdcode.Text)
End If
If m <> -1 Then
t1.RichTextBox1.Text = ""
t1.RichTextBox1.SelStart = 0
i = m
playermore(cd, i, 1) = MDCAT.MDtitel.ListCount
playermore(cd, i, 2) = MDCAT.Cdandsinger.Text
playermore(cd, i, 3) = ""
If mdcdname.Text <> " - " Then playermore(cd, i, 3) = mdcdname.Text
playermore(cd, i, 4) = ""
For ego = 1 To MDCAT.MDtitel.ListCount
player(cd, i, ego) = MDCAT.MDtitel.List(ego - 1)
playerzeit(cd, i, ego) = MDCAT.zeitlist.List(ego - 1)
Next
Rem player(0,0,1): Radio Song
Rem playerzeit(0,0,1): 04:16
Load t1
t1.Show
t1.RichTextBox1.Visible = True
t1.RichTextBox1.Text = ""
Rem SendKeys playermore(cd, m, 1), 1
Rem SendKeys "~", 1
toi = playermore(cd, m, 3)
Rem If toi = "" Then toi = "-"
t1.RichTextBox1.SetFocus
t1.RichTextBox1.SelStart = Len(t1.RichTextBox1.Text)
SendKeys toi, 1
SendKeys "~", 1
t1.RichTextBox1.SetFocus
t1.RichTextBox1.SelStart = Len(t1.RichTextBox1.Text)
SendKeys playermore(cd, m, 4), 1
SendKeys "~", 1
If playermore(cd, m, 2) <> "c:\center\pics/bild.jpg" Then SendKeys playermore(cd, m, 2), 1
If playermore(cd, m, 2) = "c:\center\pics/bild.jpg" Then
susi = MDCAT.MDtitel.ListIndex + 1
susi2 = Right("000" + Mid(Str(susi), 2), 3)
susi3 = pfad + "cover\" + susi2 + ".jpg"
playermore(cd, m, 2) = susi3
SendKeys susi3, 1
End If
SendKeys "~", 1
For yemen = 1 To playermore(cd, m, 1)
SendKeys player(cd, m, yemen), 1
SendKeys "~", 1
Rem SendKeys Mid(playerzeit(m, yemen), 1, 2) + ":" + Mid(playerzeit(m, yemen), 3, 2)
SendKeys playerzeit(cd, m, yemen), 1
SendKeys "~", 1
Next
evelin = ""
For affe = 1 To Len(playermore(cd, m, 4))
topm = Mid(playermore(cd, m, 4), affe, 1)
If topm = Chr(34) Then topm = "'"
If topm = "/" Then topm = "Æ"
If topm = ":" Then topm = "Ê"
If topm = ">" Then topm = "Î"
If topm = "<" Then topm = "Ð"
If topm = "/" Then topm = "Õ"
If topm = "|" Then topm = "Ø"
If topm = "?" Then topm = "Ý"
If topm = "*" Then topm = "Þ"
evelin = evelin + topm
Next
evelin1 = evelin
evelin = ""
For affe = 1 To Len(playermore(cd, m, 3))
topm = Mid(playermore(cd, m, 3), affe, 1)
If topm = Chr(34) Then topm = "'"
If topm = "/" Then topm = "Æ"
If topm = ":" Then topm = "Ê"
If topm = ">" Then topm = "Î"
If topm = "<" Then topm = "Ð"
If topm = "/" Then topm = "Õ"
If topm = "|" Then topm = "Ø"
If topm = "?" Then topm = "Ý"
If topm = "*" Then topm = "Þ"
evelin = evelin + topm
Next
evelin2 = evelin
SendKeys "{DEL}", 1
If cd = 1 Then
ChDir pfad + "/mddatabase"
Rem Dateiname...!!!!!
t1.RichTextBox1.SaveFile Right("000" + Mid(Str(m), 2), 3) + " MD" + ".txt", 1
End If
If cd = 0 Then
ChDir pfad + "/cddatabase"
t1.RichTextBox1.SaveFile Right("000" + Mid(Str(m + 1), 2), 3) + " CD" + ".txt", 1
End If
End If
Unload t1
Rem MDCAT.MDtitel.ListIndex = 0
End Sub
Private Sub cdlade_Click()
If cdlade.ListIndex < 0 Then cdlade.ListIndex = 0
If cdlade.ListIndex >= 0 And cdlist.ListCount > 0 Then
cdlist.ListIndex = cdlade.ListIndex
End If
End Sub
Private Sub cdlist_Click()
Dim gaga As Long
Dim tim As Integer
speich = 0
If geraet = "65" Then
cdlade.ListIndex = cdlist.ListIndex
gaga = playermore(0, cdlade.ListIndex, 1)
MDtitel.Clear
zeitlist.Clear
inindex.Clear
mdcdname.Text = playermore(0, cdlade.ListIndex, 4)
MDCAT.cdautor.Text = playermore(0, cdlade.ListIndex, 3)
mdcode.Text = Right("000" + Mid(Str(cdlade.ListIndex + 1), 2), 3)
Cdandsinger.Text = playermore(0, cdlade.ListIndex, 2)
For tim = 1 To gaga
MDtitel.AddItem player(0, cdlade.ListIndex, tim)
zeitlist.AddItem playerzeit(0, cdlade.ListIndex, tim)
inindex.AddItem Right("00" + Mid(Str(tim), 2), 3)
Next
bilda
End If
If geraet = "71" Then
cdlade.ListIndex = cdlist.ListIndex
gaga = playermore(1, cdlade.ListIndex, 1)
MDtitel.Clear
zeitlist.Clear
inindex.Clear
mdcdname.Text = playermore(1, cdlade.ListIndex, 3)
MDCAT.cdautor.Text = playermore(1, cdlade.ListIndex, 3)
mdcode.Text = Right("000" + Mid(Str(cdlade.ListIndex + 1), 2), 3)
Cdandsinger.Text = playermore(1, cdlade.ListIndex, 2)
For tim = 1 To gaga
MDtitel.AddItem player(1, cdlade.ListIndex, tim)
zeitlist.AddItem playerzeit(1, cdlade.ListIndex, tim)
inindex.AddItem Right("00" + Mid(Str(tim), 2), 3)
Next
bilda
End If
End Sub
Private Sub CheckBox1_Click()
If CheckBox1.Value = 1 Then
oplay.Visible = False
End If
If CheckBox1.Value = 0 Then
oplay.Visible = True
End If
End Sub
Private Sub Einlesen_Click()
If MDCAT.OptionButton1.Value = True Then
Rem stop
Cds 2, &H2
Rem Zeiteneinlesen
refreshit
Rem Titel der MD anzeigen
titelermittelnn
Rem Zeitenangaben
auswertenn
Rem MD Titel einlesen
titeleinlesenn
speich = 1
End If
If MDCAT.OptionButton2.Value = True Then
Rem CD ist nun dran
End If
End Sub
Private Sub inindex_Change()
MDtitel.ListIndex = MDCAT.inindex.ListIndex
End Sub
Private Sub inindex_Click()
MDtitel.ListIndex = MDCAT.inindex.ListIndex
End Sub
Private Sub inindex_DblClick()
MDtitel.ListIndex = MDCAT.inindex.ListIndex
playdoppelclick
End Sub
Private Sub ScrollBar1_Change()
End Sub
Private Sub zeitit_click()
restzeit
End Sub
' Convert's the mouses coordinate system to
' a pixel position.
Public Function MickeyXToPixel(ByVal mouseX As Long) As Long
Dim X As Long
Dim Y As Long
Dim tX As Single
Dim tmouseX As Single
Dim tMickeys As Single
GetScreenRes X, Y
tX = X
tMickeys = MOUSE_MICKEYS
tmouseX = mouseX
MickeyXToPixel = CLng(tmouseX / (tMickeys / tX))
End Function
' Converts mouse Y coordinates to pixels
Public Function MickeyYToPixel(ByVal mouseY As Long) As Long
Dim X As Long
Dim Y As Long
Dim tY As Single
Dim tmouseY As Single
Dim tMickeys As Single
GetScreenRes X, Y
tY = Y
tMickeys = MOUSE_MICKEYS
tmouseY = mouseY
MickeyYToPixel = CLng(tmouseY / (tMickeys / tY))
End Function
' Converts pixel X coordinates to mickeys
Public Function PixelXToMickey(ByVal pixX As Long) As Long
Dim X As Long
Dim Y As Long
Dim tX As Single
Dim tpixX As Single
Dim tMickeys As Single
GetScreenRes X, Y
tMickeys = MOUSE_MICKEYS
tX = X
tpixX = pixX
PixelXToMickey = CLng((tMickeys / tX) * tpixX)
End Function
' Converts pixel Y coordinates to mickeys
Public Function PixelYToMickey(ByVal pixY As Long) As Long
Dim X As Long
Dim Y As Long
Dim tY As Single
Dim tpixY As Single
Dim tMickeys As Single
GetScreenRes X, Y
tMickeys = MOUSE_MICKEYS
tY = Y
tpixY = pixY
PixelYToMickey = CLng((tMickeys / tY) * tpixY)
End Function
' The function will center the mouse on a window
' or control with an hWnd property. No checking
' is done to ensure that the window is not obscured
' or not minimized, however it does make sure that
' the target is within the boundaries of the
' screen.
Public Function CenterMouseOn(ByVal hwnd As Long) As Boolean
Dim X As Long
Dim Y As Long
Dim maxX As Long
Dim maxY As Long
Dim crect As RECT
Dim rc As Long
GetScreenRes maxX, maxY
rc = GetWindowRect(hwnd, crect)
If rc Then
X = crect.Left + ((crect.Right - crect.Left) / 2)
Y = crect.Top + ((crect.Bottom - crect.Top) / 2)
If (X >= 0 And X <= maxX) And (Y >= 0 And Y <= maxY) Then
MouseMove X, Y
CenterMouseOn = True
Else
CenterMouseOn = False
End If
Else
CenterMouseOn = False
End If
End Function
' Simulates a mouse click
Public Function MouseFullClick(ByVal MBClick As enButtonToClick) As Boolean
Dim cbuttons As Long
Dim dwExtraInfo As Long
Dim mevent As Long
Select Case MBClick
Case btcLeft
mevent = MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP
Case btcRight
mevent = MOUSEEVENTF_RIGHTDOWN Or MOUSEEVENTF_RIGHTUP
Case btcMiddle
mevent = MOUSEEVENTF_MIDDLEDOWN Or MOUSEEVENTF_MIDDLEUP
Case Else
MouseFullClick = False
Exit Function
End Select
mouse_event mevent, 0&, 0&, cbuttons, dwExtraInfo
MouseFullClick = True
End Function
Public Sub MouseMove(ByRef xPixel As Long, ByRef yPixel As Long)
Dim cbuttons As Long
Dim dwExtraInfo As Long
mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, _
PixelXToMickey(xPixel), PixelYToMickey(yPixel), cbuttons, dwExtraInfo
End Sub
Private Sub cdlade_Change()
If cdlade.ListIndex < 0 Then cdlade.ListIndex = 0
If cdlade.ListIndex > 0 Then
cdlist.ListIndex = cdlade.ListIndex
End If
End Sub
Private Sub CheckBox1_Change()
If CheckBox1.Value = 1 Then
oplay.Visible = 0
End If
If CheckBox1.Value = 0 Then
oplay.Visible = 1
End If
End Sub
Private Sub CommandButton10_Click()
Cds 1, 2
End Sub
Private Sub titeleinlesenn()
Dim ogatt, start, Mac, tvcinq, stel, ton, stega As Integer
Dim zw, pipa, positionn, hexy, itt1, itt, tittext, timuxxx, wog, onkel, muo As String
ReDim auswert(500)
ogatt = MDtitel.ListCount
MDtitel.Clear
MDCAT.inindex.Clear
For Mac = 1 To ogatt
Rem prozentt.Caption = Str(ogatt - Mac) + " %"
pipa = Hex(Mac)
positionn = Right("000" + pipa, 2)
zw = "20"
hexy = "4E"
Rem sami "810905YZ2045DSKTRK 0xFF"
sami "81090547" + zw + hexy + positionn + "00FF"
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 0.5
Loop
itt = ""
nichtfertig:
trackdateholennn
itt1 = outpp
If itt1 = "" Or itt1 = "900705472086FF" Then
Rem Titel hat keinen Namen
tittext = "-"
GoTo haha:
End If
itt = itt + itt1
Rem If Right(itt1, 4) <> "00FF" And Right(itt1, 4) <> "20FF" Then
If Right(itt1, 4) <> "00FF" Then
GoTo nichtfertig:
End If
onkel = itt
tvcinq = 1
schleife:
stel = InStr(1, onkel, "FF")
If (stel / 2) = Int(stel / 2) Then
stel = InStr(stel + 1, onkel, "FF")
End If
If stel > 0 Then
auswert(tvcinq) = Mid(onkel, 1, stel - 1)
If (stel + 2) < Len(onkel) Then
onkel = Mid(onkel, stel + 2)
tvcinq = tvcinq + 1
GoTo schleife
End If
End If
itt = ""
For ton = 1 To tvcinq
If Mid(auswert(ton), 11, 2) = "5B" Or Mid(auswert(ton), 11, 2) = "5A" Then
itt = itt + Mid(auswert(ton), 15)
End If
Next
wog = itt
tittext = ""
For stega = 1 To (Len(wog) - 2) / 2
muo = Mid(wog, stega * 2 - 1, 2)
timuxxx = "&H" + muo
Rem muo muss von hex in Dec umgewandelt werden
If muo <> "00" Then tittext = tittext + Chr("&H" + muo)
Next
haha:
MDtitel.AddItem tittext
MDCAT.inindex.AddItem Right("000" + Mid(Str(Mac), 2), 3)
Next
Rem prozentt.Visible = False
End Sub
Private Sub CommandButton18_Click()
titeleinlesenn
End Sub
Private Sub CommandButton19_Click()
Dim tgg, TrackNumber, args, trackname As String
Dim sigi, hem, iga As Integer
TrackNumber = "01"
sigi = 0
args = Chr(Hex(1))
Rem stopstop
Rem iga = Val(TextBox1.Text)
tgg = ""
For hem = 0 To 13
tgg = tgg + Chr(hem + iga)
Rem tgg = tgg + Chr(Hex(Mid(Str(iga + hem), 2)))
trackname = tgg
Next
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(TrackNumber) & Chr(0) & Chr(0) & Left(Mid(trackname, 1, 14) & String(14, Chr(&H0)), 14) & Chr(&HFF)
End Sub
Private Sub mdcdname_AfterUpdate()
Dim TrackNumber, start, sigi As Integer
Dim zahl, trackname, args As String
TrackNumber = 0
zahl = ""
On Error GoTo honi:
zahl = mdcdname.Text
honi:
If mdcode.Text <> "" Then zahl = zahl + " Æ" + mdcode.Text + "Æ"
trackname = zahl
silfi:
If trackname <> "" Then
'MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(&H1) & Chr(0) & Chr(0) & "helo" & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&HFF)
Rem c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(TrackNumber) & Chr(0) & Chr(0) & Left(TrackName & String(14, Chr(&H0)), 14) & Chr(&HFF)
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(TrackNumber) & Chr(0) & Chr(0) & Left(Mid(trackname, 1, 14) & String(14, Chr(&H0)), 14) & Chr(&HFF)
For sigi = 1 To (Len(trackname) / 16)
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 1
Loop
args = Chr(Hex(sigi + 1))
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9B) & args & Left(Mid(trackname, (sigi * 16) - 1) & String(16, Chr(&H0)), 16) & Chr(&HFF)
Next
End If
End Sub
Private Sub mdcdname_Exit()
End Sub
Private Sub welchesgeraet()
Dim xxa, start, tvcinq, ton, stega, timuxxx As Integer
Dim zw, itt1, onkel, hexy, itt, wog, stel, muo, tittext As String
ReDim auswert(500)
xxa = Hex(geraet)
zw = "20"
hexy = "22"
sami "810905" + xxa + zw + hexy + "0100FF"
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 0.5
Loop
itt = ""
nichtfertig:
trackdateholennn
Rem cobra
Rem 900705472085FF
itt1 = outpp
itt = itt + itt1
If Right(itt1, 4) <> "00FF" Then
GoTo nichtfertig:
End If
onkel = itt
tvcinq = 1
schleife:
stel = InStr(1, onkel, "FF")
If (stel / 2) = Int(stel / 2) Then
stel = InStr(stel + 1, onkel, "FF")
End If
If stel > 0 Then
auswert(tvcinq) = Mid(onkel, 1, stel - 1)
If (stel + 2) < Len(onkel) Then
onkel = Mid(onkel, stel + 2)
tvcinq = tvcinq + 1
GoTo schleife
End If
End If
itt = ""
For ton = 1 To tvcinq
If Mid(auswert(ton), 11, 2) = "22" Then
itt = itt + Mid(auswert(ton), 13)
End If
Next
wog = itt
tittext = ""
For stega = 1 To (Len(wog) - 2) / 2
muo = Mid(wog, stega * 2 - 1, 2)
timuxxx = "&H" + muo
Rem muo muss von hex in Dec umgewandelt werden
If muo <> "00" Then tittext = tittext + Chr("&H" + muo)
Next
haha:
geraetcod.Caption = tittext
End Sub
Private Sub titelermittelnn()
ReDim auswert(500)
Dim Antwort As String
Dim zw, muo, titext, wog, timuxxx, onkel, itt1, tittext, itt, hexy As String
Dim stel, tipos2, tipos1, stega, ton, start, tvcinq As Integer
zw = "20"
hexy = "4D"
sami "81090547" + zw + hexy + "0100FF"
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 0.5
Loop
itt = ""
nichtfertig:
trackdateholennn
Rem cobra
Rem 900705472085FF
itt1 = outpp
itt = itt + itt1
If itt1 = "" Or itt1 = "900705472085FF" Then
Rem Titel hat keinen Namen
tittext = "no Trackname"
GoTo haha:
End If
Rem itt = itt + itt1
If Right(itt1, 4) <> "00FF" Then
Rem If Right(itt1, 4) <> "00FF" And Right(itt1, 4) <> "20FF" Then
GoTo nichtfertig:
End If
onkel = itt
tvcinq = 1
schleife:
stel = InStr(1, onkel, "FF")
If (stel / 2) = Int(stel / 2) Then
stel = InStr(stel + 1, onkel, "FF")
End If
If stel > 0 Then
auswert(tvcinq) = Mid(onkel, 1, stel - 1)
If (stel + 2) < Len(onkel) Then
onkel = Mid(onkel, stel + 2)
tvcinq = tvcinq + 1
GoTo schleife
End If
End If
itt = ""
For ton = 1 To tvcinq
If Mid(auswert(ton), 11, 2) = "58" Or Mid(auswert(ton), 11, 2) = "59" Then
itt = itt + Mid(auswert(ton), 15)
End If
Next
wog = itt
tittext = ""
For stega = 1 To (Len(wog) - 2) / 2
muo = Mid(wog, stega * 2 - 1, 2)
timuxxx = "&H" + muo
Rem muo muss von hex in Dec umgewandelt werden
If muo <> "00" Then tittext = tittext + Chr("&H" + muo)
Next
haha:
mdcode.Text = ""
tipos1 = 0
tipos2 = 0
tipos1 = InStr(1, tittext, "Æ")
If tipos1 > 0 Then tipos2 = InStr(1, Mid(tittext, tipos1 + 1), "Æ")
If tipos1 > 0 And tipos2 > 0 Then
mdcode.Text = Mid(tittext, tipos1 + 1, tipos2 - 1)
tittext = Mid(tittext, 1, tipos1 - 1) + Mid(tittext, tipos1 + tipos2 + 1)
Else
Rem nun muss eine neu MD-Zahl vergeben werden
Antwort = MsgBox("New MD,...", , "Error") ' Meldung anzeigen.
End If
mdcdname.Text = ""
mdcdname.Text = tittext
If tittext = "" Then
titext = "no Trackname"
mdcdname.Text = titext
End If
End Sub
Private Sub discnameedit()
Dim TrackNumber, sigi, start As Long
Dim zahl As String
Dim trackname, args As String
TrackNumber = 0
zahl = ""
On Error GoTo honi:
zahl = mdcdname.Text
honi:
If mdcode.Text <> "" Then zahl = zahl + " Æ" + mdcode.Text + "Æ"
trackname = zahl
silfi:
If trackname <> "" Then
'MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(&H1) & Chr(0) & Chr(0) & "helo" & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&HFF)
Rem c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(TrackNumber) & Chr(0) & Chr(0) & Left(TrackName & String(14, Chr(&H0)), 14) & Chr(&HFF)
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(TrackNumber) & Chr(0) & Chr(0) & Left(Mid(trackname, 1, 14) & String(14, Chr(&H0)), 14) & Chr(&HFF)
For sigi = 1 To (Len(trackname) / 16)
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 1
Loop
args = Chr(Hex(sigi + 1))
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9B) & args & Left(Mid(trackname, (sigi * 16) - 1) & String(16, Chr(&H0)), 16) & Chr(&HFF)
Next
End If
End Sub
Private Sub mdcdname_LostFocus()
If OptionButton1.Value = True Then discnameedit
End Sub
Private Sub Option1_Click()
On Error GoTo jam:
If Option1.Value = True Then c1.MSComm1.CommPort = 1
jam:
End Sub
Private Sub Option2_Click()
On Error GoTo jam:
If Option2.Value = True Then c1.MSComm1.CommPort = 2
jam:
End Sub
Private Sub Option3_Click()
On Error GoTo jam:
If Option3.Value = True Then c1.MSComm1.CommPort = 3
jam:
End Sub
Private Sub Option4_Click()
On Error GoTo jam:
If Option4.Value = True Then c1.MSComm1.CommPort = 4
jam:
End Sub
Private Sub OptionButton1_Click()
cdmdchang
End Sub
Private Sub OptionButton2_Click()
cdmdchang
End Sub
Private Sub steuer_Change()
If steuer.Text = "1" Then
Dim arg1 As String
arg1 = "21"
c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(arg1) & Chr(&HFF)
steuer.Text = ""
End If
If steuer.Text = "3" Then
arg1 = "22"
c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(arg1) & Chr(&HFF)
steuer.Text = ""
End If
If steuer.Text = "5" Then
Rem divide?
Rem Rem 0x81 0x08 0x05 0xYZ 0x20 0x44 DSK 0xFF
c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H20) & Chr(&H32) & Chr(&HFF)
steuer.Text = ""
End If
If steuer.Text = "2" Then
Rem 0x02 0x03
c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(&H3) & Chr(&HFF)
steuer.Text = ""
End If
End Sub
Private Sub titelermitteln_click()
titelermittelnn
End Sub
Private Sub CommandButton15_Click()
c1.MSComm1.PortOpen = False
End Sub
Private Sub CommandButton16_Click()
Dim alttocen, trackanzahl, rechenbasis, neuwert, jemi As Integer
Dim tocen, mina, seca As String
Dim Toc As String
refreshit
alttocen = 150
tocen = "150"
trackanzahl = zeitlist.ListCount
For jemi = 1 To trackanzahl
Rem If jemi <> trackanzahl Then tocen = tocen + " "
rechenbasis = alttocen
mina = Left(zeitlist.List(jemi - 1), 2)
seca = Right(zeitlist.List(jemi - 1), 2)
neuwert = rechenbasis + (mina * 60 + seca) * 75 + 152
tocen = tocen + Str(neuwert)
alttocen = neuwert
Next
Rem 150 19502 39829 62181 77333 94810 111912 130589 146341 162993 181895 200497
If tocen = "" Then
MsgBox "You must get a toc to display disc info"
Else
Toc = tocen
tocenn = Toc
On Error GoTo flat:
discinfo1.Show 1
Rem vbModal, Me
GoTo noflat:
flat:
MsgBox ("Leider ist nun ein Fehler aufgetreten")
noflat:
Rem Me.txttoc.Text = ""
End If
End Sub
Private Sub CommandButton17_Click()
Rem sami "811707B0xxFF"
Rem play 00
Rem 810705410240FF
Rem sami "811705B00000FF"
Rem Stop
End Sub
Private Sub ejekt_Click()
If geraet = &H47 Then sami "810705470240FF"
If geraet = &H41 Then sami "810705410240FF"
Rem repeat??? 810C0547202000A8A40100FF
End Sub
Private Sub getname_click()
Dim tracky As Integer
tracky = 1
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H5A) & tracky & Chr(&H1) & Chr(&HFF)
datenholennn
End Sub
Private Sub CommandButton11_Click()
Dim ui As Integer
Rem Cds Val(MDCAT.xxx.Text), Val(yyy.Text)
Rem ui = Val(yyy.Text)
ui = ui + 1
Rem yyy.Text = Mid(Str(ui), 2)
End Sub
Private Sub refreshit()
ReDim traki(256)
ReDim mina(256)
ReDim seca(256)
Dim wieoft As Integer
Dim track, dita, savees, wichtig, trackanzahl, itt As String
Dim disk, trackizeit, tiger, uki, arg2, arg1 As String
disk = "01"
track = "01"
zeitlist.Clear
MDCAT.inindex.Clear
MDtitel.Clear
If OptionButton2.Value = True Then
Rem sami "810705411001FF"
disk = Right("0" + Hex(cdlade.List(cdlade.ListIndex)), 2)
arg1 = Val(disk)
arg2 = Val(track)
Rem c1.MSComm1.Output = Chr(&H81) & Chr(&H9) & Chr(&H5) & Chr(&H41) & Chr(&H3) & Chr(&H42) & Chr(ARg1) & Chr(arg2) & Chr(&HFF)
Rem kuchen
End If
If OptionButton1.Value = True Then sami "810705471001FF"
If OptionButton1.Value = True Then
sami "810905470343" + disk + track + "FF"
End If
If OptionButton2.Value = True Then
sami "810905410343" + disk + track + "FF"
End If
Rem If OptionButton1.Value = True Then c1.MSComm1.Output = Chr(&H81) & Chr(&H9) & Chr(&H5) & Chr(&H47) & Chr(&H3) & Chr(&H42) & Chr(ARg1) & Chr(arg2) & Chr(&HFF)
Rem If OptionButton2.Value = True Then c1.MSComm1.Output = Chr(&H81) & Chr(&H9) & Chr(&H5) & Chr(&H41) & Chr(&H3) & Chr(&H42) & Chr(ARg1) & Chr(arg2) & Chr(&HFF)
oska:
datenholennn
itt = outpp
If Mid(itt, 3, 2) <> "0B" Then GoTo oska
If OptionButton1.Value = True Then
sami "810805472044" + disk + "FF"
End If
If OptionButton2.Value = True Then
sami "810805412044" + disk + "FF"
End If
oska2:
datenholennn
itt = outpp
If Mid(itt, 3, 2) <> "0D" Then GoTo oska2
datenholennn
wichtig = outpp
trackanzahl = Str(CDec("&H" + Mid(wichtig, 1, 2)))
Stop
For wieoft = 1 To trackanzahl
uki = Hex(wieoft)
Rem Right("0" + Hex(deut.ListIndex + 1), 2)
tiger = Right("0" + Hex(wieoft), 2)
If OptionButton1.Value = True Then
sami "810905472045" + disk + tiger + "FF"
End If
If OptionButton2.Value = True Then
sami "810905412045" + disk + tiger + "FF"
End If
nika:
datenholennn
savees = outpp
If Mid(outpp, 3, 2) <> "0B" Then GoTo nika:
datenholennn
dita = outpp
If outpp = "" Then
mina(wieoft) = 0
seca(wieoft) = 10
GoTo segen:
End If
If outpp <> "" Then mina(wieoft) = CDec("&H" + Mid(dita, 1, 2))
seca(wieoft) = 0
If Len(dita) > 2 Then seca(wieoft) = CDec("&H" + Mid(dita, 3, 2))
segen:
Rem dupfbacke
trackizeit = Right("0000" + Mid(Str(mina(wieoft)), 2), 2) + ":" + Right("0000" + Mid(Str(seca(wieoft)), 2), 2)
zeitlist.AddItem trackizeit
MDtitel.AddItem "Track " + Str(wieoft)
MDCAT.inindex.AddItem Right("000" + Mid(Str(wieoft), 2), 3)
Next
Rem remote ausschalten
If OptionButton1.Value = True Then
sami "810705471002FF"
End If
If OptionButton2.Value = True Then
sami "810705411002FF"
End If
End Sub
Private Sub CommandButton12_Click()
refreshit
restzeit
End Sub
Private Sub tracknameeingeben()
Dim sigi, oga, foxi, start, piksa, figi, pikss As Integer
Dim Mldgg, args, Titelg, Mldg, Titel, Voreinstellung As String
Dim zahl, wert1, trackname, Voreinstellungg As String
Dim TestDaten As Object
Dim TrackNumber As Integer
If OptionButton1.Value = True Then
ReDim mist(256)
If zeitlist.ListIndex < 0 Then TrackNumber = 0
Rem TrackName = suchit.Text
TrackNumber = zeitlist.ListIndex + 1
Rem Set TestDaten = NewDataObject
Rem TestDaten.GetFromClipboard
zahl = ""
On Error GoTo honi:
zahl = TestDaten.GetText(1)
honi:
If TrackNumber = 0 Then
Mldgg = "MD Name" ' Aufforderung festlegen.
Titelg = "Titel der Mini Disc:" ' Titel festlegen.
If zahl = "" Then zahl = ""
Voreinstellungg = zahl ' Voreinstellung festlegen.
' Meldung, Titel und Standardwert anzeigen.
wert1 = InputBox(Mldgg, Titelg, Voreinstellungg)
trackname = wert1
GoTo silfi:
End If
Mldg = "MD Name von Track (" + Mid(Str(TrackNumber), 2) + ")" ' Aufforderung festlegen.
Titel = "Titel des Tracks:" ' Titel festlegen.
If zahl = "" Then zahl = "MD-Name"
Voreinstellung = zahl ' Voreinstellung festlegen.
' Meldung, Titel und Standardwert anzeigen.
wert1 = InputBox(Mldg, Titel, Voreinstellung)
trackname = wert1
silfi:
If trackname <> "" Then
'MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(&H1) & Chr(0) & Chr(0) & "helo" & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&HFF)
Rem c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(TrackNumber) & Chr(0) & Chr(0) & Left(TrackName & String(14, Chr(&H0)), 14) & Chr(&HFF)
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(TrackNumber) & Chr(0) & Chr(0) & Left(Mid(trackname, 1, 14) & String(14, Chr(&H0)), 14) & Chr(&HFF)
For sigi = 1 To (Len(trackname) / 16)
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 1
Loop
args = Chr(Hex(sigi + 1))
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9B) & args & Left(Mid(trackname, (sigi * 16) - 1) & String(16, Chr(&H0)), 16) & Chr(&HFF)
Next
nichtanruehren:
oga = MDtitel.ListIndex
foxi = MDtitel.ListCount
For piksa = 0 To foxi - 1
mist(piksa) = MDtitel.List(piksa)
Next
If oga = -1 Then GoTo heimat:
mist(oga) = trackname
figi = MDtitel.ListIndex
MDtitel.Clear
For pikss = 0 To foxi - 1
MDtitel.AddItem mist(pikss)
Next
MDtitel.ListIndex = figi
End If
End If
If OptionButton2.Value = True Then
cdbenamsen
End If
heimat:
End Sub
Private Sub cdbenamsen()
Dim sigi, oga, foxi, start, piksa, pikss, figi As Integer
Dim Mldgg, args, Titelg, Mldg, Titel, Voreinstellung As String
Dim zahl, wert1, trackname, Voreinstellungg As String
Dim TestDaten As Object
Dim TrackNumber As Integer
ReDim mist(256)
If zeitlist.ListIndex < 0 Then TrackNumber = 0
Rem TrackName = suchit.Text
TrackNumber = zeitlist.ListIndex + 1
Rem Set TestDaten = NewDataObject
Rem TestDaten.GetFromClipboard
zahl = ""
On Error GoTo honi:
zahl = TestDaten.GetText(1)
honi:
If TrackNumber = 0 Then
Mldgg = "MD Name" ' Aufforderung festlegen.
Titelg = "Titel der Mini Disc:" ' Titel festlegen.
If zahl = "" Then zahl = ""
Voreinstellungg = zahl ' Voreinstellung festlegen.
' Meldung, Titel und Standardwert anzeigen.
wert1 = InputBox(Mldgg, Titelg, Voreinstellungg)
trackname = wert1
GoTo silfi:
End If
Mldg = "MD Name von Track (" + Mid(Str(TrackNumber), 2) + ")" ' Aufforderung festlegen.
Titel = "Titel des Tracks:" ' Titel festlegen.
If zahl = "" Then zahl = "MD-Name"
Voreinstellung = zahl ' Voreinstellung festlegen.
' Meldung, Titel und Standardwert anzeigen.
wert1 = InputBox(Mldg, Titel, Voreinstellung)
trackname = wert1
silfi:
If MDCAT.OptionButton2.Value = True Then GoTo nichtanruehren:
If trackname <> "" Then
'MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(&H1) & Chr(0) & Chr(0) & "helo" & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&HFF)
Rem c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(TrackNumber) & Chr(0) & Chr(0) & Left(TrackName & String(14, Chr(&H0)), 14) & Chr(&HFF)
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(TrackNumber) & Chr(0) & Chr(0) & Left(Mid(trackname, 1, 14) & String(14, Chr(&H0)), 14) & Chr(&HFF)
For sigi = 1 To (Len(trackname) / 16)
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 1
Loop
args = Chr(Hex(sigi + 1))
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9B) & args & Left(Mid(trackname, (sigi * 16) - 1) & String(16, Chr(&H0)), 16) & Chr(&HFF)
Next
nichtanruehren:
oga = MDtitel.ListIndex
foxi = MDtitel.ListCount
For piksa = 0 To foxi - 1
mist(piksa) = MDtitel.List(piksa)
Next
If oga = -1 Then GoTo heimat:
mist(oga) = trackname
figi = MDtitel.ListIndex
MDtitel.Clear
For pikss = 0 To foxi - 1
MDtitel.AddItem mist(pikss)
Next
MDtitel.ListIndex = figi
End If
heimat:
End Sub
Private Sub CommandButton13_Click()
tracknameeingeben
End Sub
Private Sub misttt()
Dim trackname As String
Dim start As Integer
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 1
Loop
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9B) & Chr(&H3) & Left(Mid(trackname, 31) & String(16, Chr(&H0)), 16) & Chr(&HFF)
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 1
Loop
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9B) & Chr(&H4) & Left(Mid(trackname, 47) & String(16, Chr(&H0)), 16) & Chr(&HFF)
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 1
Loop
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9B) & Chr(&H5) & Left(Mid(trackname, 63) & String(16, Chr(&H0)), 16) & Chr(&HFF)
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 1
Loop
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9B) & Chr(&H6) & Left(Mid(trackname, 79) & String(16, Chr(&H0)), 16) & Chr(&HFF)
End Sub
Private Sub CommandButton14_Click()
sami "810C0547202000A8A40100FF"
End Sub
Private Sub CommandButton2_Click()
Dim meinvorgang As Object
Dim tasks As Object
Dim nich As Integer
Dim sutmii As String
For Each meinvorgang In tasks
If meinvorgang.Name = "MD Editor2" = True Then
nich = 1
On Error GoTo oarg:
meinvorgang.Activate
Rem meinVorgang.WindowState = wdWindowStateMaximize
oarg:
End If
Next
If nich = 0 Then
sutmii = Shell(pfad + "MD Editor2/mdeditor2.exe", vbNormalFocus)
End If
End Sub
Private Sub CommandButton3_Click()
Unload MDCAT
End Sub
Private Sub CommandButton4_Click()
Unload MDCAT
End Sub
Private Sub CommandButton6_Click()
Dim pip As String
c1.MSComm1.PortOpen = False
pip = Shell("C:\center\MD Editor2\mdeditor2.exe", vbMinimizedFocus)
End Sub
Private Sub CommandButton7_Click()
Rem MouseMove Val(X2.Text), Val(Y2.Text)
End Sub
Private Sub CommandButton8_Click()
Dim meinvorgang As Object
Dim tasks As Object
Dim nich, start As Integer
Dim sutmii As String
For Each meinvorgang In tasks
If meinvorgang.Name = "MD Editor2" = True Then
nich = 1
On Error GoTo oarg:
meinvorgang.Activate
Rem meinVorgang.WindowState = wdWindowStateMaximize
oarg:
End If
Next
If nich = 0 Then
sutmii = Shell("c:/center/MD Editor2/mdeditor2.exe", vbNormalFocus)
End If
MouseMove 97, 43
MouseFullClick btcLeft
MouseMove 97, 43
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 0.5
Loop
MouseFullClick btcLeft
MouseMove 978, 5
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 0.5
Loop
MouseFullClick btcLeft
MouseMove 97, 43
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 0.5
Loop
MouseFullClick btcLeft
tiber
End Sub
Private Sub tiber()
Dim tasks, meinvorgang, wdWindowStateMaximize As Object
Dim nich As Integer
For Each meinvorgang In tasks
If meinvorgang.Name = "MD Windows" = True Then
nich = 1
On Error GoTo oarg2:
meinvorgang.Activate
meinvorgang.WindowState = wdWindowStateMaximize
oarg2:
End If
Next
End Sub
Private Sub CommandButton9_Click()
Load weblink
weblink.Show
End Sub
Private Sub einlesenn_Click()
Dim tito As String
Dim tit, start, ut As Integer
tiber
MouseMove 90, 100
MouseFullClick btcRight
MouseMove 94, 104
MouseFullClick btcRight
SendKeys "{DEL}", 1
tito = "C:\center\Okt01\Md.csv"
For tit = 1 To Len(tito)
ut = Mid(tito, tit, 1)
SendKeys "{" + ut + "}", 1
Next
SendKeys "{TAB}", 1
SendKeys "{TAB}", 1
SendKeys "~", 1
SendKeys "J", 1
MouseMove 980, 9
MouseFullClick btcLeft
MouseFullClick btcLeft
MouseMove 980, 65
MouseFullClick btcLeft
MouseMove 980, 65
MouseFullClick btcRight
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 1
Loop
SendKeys "K", 1
Rem NUN IST DIE MD abgespeichert und der Titel im Zwischenspeicher
End Sub
Private Sub Cds(arg1 As Integer, arg2 As Integer)
On Error GoTo shit:
If OptionButton1.Value = True Then c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(&H47) & Chr(arg1) & Chr(arg2) & Chr(&HFF)
If OptionButton2.Value = True Then c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(&H41) & Chr(arg1) & Chr(arg2) & Chr(&HFF)
GoTo rub:
shit:
rub:
End Sub
Private Sub fstop_Click()
Cds 2, &H2
End Sub
Private Sub MDtitel_Change()
End Sub
Private Sub MDtitel_Click()
zeitlist.ListIndex = MDtitel.ListIndex
If MDtitel.ListIndex >= 0 And MDCAT.inindex.ListCount >= MDtitel.ListIndex Then MDCAT.inindex.ListIndex = MDtitel.ListIndex
End Sub
Private Sub MDtitel_DblClick()
zeitlist.ListIndex = MDtitel.ListIndex
MDCAT.inindex.ListIndex = MDtitel.ListIndex
playdoppelclick
End Sub
Private Sub mist_Click()
End Sub
Private Sub OptionButton1_Change()
cdmdchang
End Sub
Private Sub cdmdchang()
Dim playerzeiger As Integer
speich = 0
Cds 1, 2
If OptionButton1.Value = True Then
mdcdname.Width = 6975
cdp.Visible = False
geraet = &H47
cdlist.Clear
cdlade.Visible = False
Image7.Visible = False
Image9.Visible = True
Image11.Visible = True
Image10.Visible = True
resttime.Visible = True
prozentuel.Visible = True
alltime.Visible = True
alltogether.Visible = True
Cdandsinger = ""
welchesgeraet
cdlist.Clear
zeitlist.Clear
Rem rumba
For playerzeiger = 1 To mdanzahl
cdlist.AddItem Right("000" + Mid(Str(playerzeiger), 2), 3) + " " + player(1, playerzeiger - 1, 0)
Next
End If
If OptionButton2.Value = True Then
mdcdname.Width = 4455
cdp.Visible = True
Image11.Visible = False
Image10.Visible = False
resttime.Visible = False
prozentuel.Visible = False
alltime.Visible = False
alltogether.Visible = False
geraet = &H41
cdlade.Visible = True
cdlist.Clear
zeitlist.Clear
For playerzeiger = 1 To 200
cdlist.AddItem Right("000" + Mid(Str(playerzeiger), 2), 3) + " " + player(0, playerzeiger - 1, 0)
Next
welchesgeraet
End If
End Sub
Private Sub Form_Load()
' playermore(0,0,1): 11
' playermore(0,0,2): c:\center\\cover\001.jpg
' playermore(0,0,3): R.E.M.
' playermore(0,0,4): Out of Time
' player(0,0,1): Radio Song
' playerzeit(0,0,1): 04:16
Dim xu As Integer
Dim Control As Object
laufwbestimmen
MDCAT.pfadlabel.Caption = pfad
If OptionButton1.Value = True Then geraet = &H47
If OptionButton2.Value = True Then geraet = &H41
Rem pfad = "C:\center\"
eon
For xu = 1 To 200
cdlade.AddItem Right("00" + Mid(Str(xu), 2), 3)
Next
cdlade.ListIndex = 0
Dim isReg As Boolean
Dim ops As CddbOptions
Dim proxy As Variant
' The first call should set the client information within the control
' The CDDBControl object is available on the main form
Set Control = c1.CDDBControl1
' You must set the client ID and Tag to use this application
'Control.SetClientInfo "YourID", "YourTag", "1", "regString"
Rem ClientId 15731712
Rem Tag 8783988761BD5C951BDEA06E03135783
On Error GoTo mistt:
Control.SetClientInfo "15731712", "8783988761BD5C951BDEA06E03135783", "1", "regString"
Rem control.Initialize
c1.CDDBControl1.Initialize hwnd, CACHE_DEFAULT
'Set Options to test submit mode. Change TestSubmitMode to False before releasing your
'application to your users once the application has been validated
Set ops = Control.GetOptions
ops.TestSubmitMode = True
Control.SetOptions ops
'If connecting to the Internet through a proxy, get proxy information
Rem proxy = MsgBox("Are you connecting to the internet through a proxy?", vbYesNo)
Rem If proxy = vbYes Then ProxyInfo.Show vbModal, Me
' If the user is not already registered, bring up the default registration
' dialog. (This is also available through the visible control)
isReg = Control.IsRegistered(0)
If isReg = False Then
isReg = Control.IsRegistered(1)
End If
mistt:
reinlanden
mdreinladen
Cds 1, 2
welchesgeraet
cdmdchang
End Sub
Private Sub OptionButton2_Change()
cdmdchang
End Sub
Private Sub plays_Click()
c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(&H1) & Chr(&HFF)
End Sub
Private Sub eon()
On Error GoTo shit:
Rem c1.MSComm1.CommPort = GetSetting("MP3MDSPC2", "Commport", "COM", "1")
Rem OLGA
If Option1.Value = True Then c1.MSComm1.CommPort = 1
If Option2.Value = True Then c1.MSComm1.CommPort = 2
If Option3.Value = True Then c1.MSComm1.CommPort = 3
If Option4.Value = True Then c1.MSComm1.CommPort = 4
c1.MSComm1.PortOpen = True
shit:
End Sub
Private Sub fplay_Click()
Cds 2, 1
End Sub
Private Sub ftreg_Click()
Cds 2, &H28
End Sub
Private Sub poweroff_Click()
Cds 1, 3
End Sub
Private Sub reg_Click()
Cds 2, &H2
Cds 2, 16
Cds 2, &H21
End Sub
Private Sub spez_Click()
Dim discnummer, arg1, arg2, Tracknummer As Integer
discnummer = 1
Tracknummer = 5
If OptionButton2.Value = True Then discnummer = Right("0" + Hex(cdlade.List(cdlade.ListIndex)), 2)
arg1 = discnummer
arg2 = Tracknummer
Rem c1.MSComm1.Output = Chr(&H81) & Chr(&H9) & Chr(&H5) & Chr(&H41) & Chr(&H3) & Chr(&H42) & Chr(ARg1) & Chr(arg2) & Chr(&HFF)
Rem 0x81 0x09 0x05 0xYZ 0x03 0x42 DSK TRK 0xFF
If OptionButton1.Value = True Then c1.MSComm1.Output = Chr(&H81) & Chr(&H9) & Chr(&H5) & Chr(&H47) & Chr(&H3) & Chr(&H42) & Chr(arg1) & Chr(arg2) & Chr(&HFF)
If OptionButton2.Value = True Then c1.MSComm1.Output = Chr(&H81) & Chr(&H9) & Chr(&H5) & Chr(&H41) & Chr(&H3) & Chr(&H42) & Chr(arg1) & Chr(arg2) & Chr(&HFF)
End Sub
Private Sub sami(uka As String)
Dim Antwort, esi, DADAs, hor As String
Dim tri As Integer
esi = uka
hor = ""
For tri = 1 To (Len(esi) / 2)
DADAs = Mid(esi, tri * 2 - 1, 2)
hor = hor + Chr("&H" + DADAs)
Next
esi = hor
On Error GoTo gucki:
c1.MSComm1.Output = esi
GoTo endend:
gucki:
Antwort = MsgBox("Error: Operation valid only when the port is open", , "Error") ' Meldung anzeigen.
endend:
End Sub
Private Sub trackdateholennn()
Dim ui, Starti, hic, heni, xxxu As Integer
Dim homi As String
Dim InString$, tru As String
For ui = 1 To 30
a(ui) = ""
b(ui) = ""
Next
Starti = Timer ' Anfangszeit setzen.
nothome:
c1.MSComm1.InputLen = 0
' Prüfen, ob Daten vorhanden sind.
If c1.MSComm1.InBufferCount Then
' Daten lesen.
InString$ = c1.MSComm1.Input
End If
If Timer > Starti + 2 Then GoTo sonne:
If InString$ = "" Then GoTo nothome:
sonne:
For hic = 1 To Len(InString$)
tru = Mid(InString$, hic, 1)
a(hic) = Str(Asc(tru))
heni = Val(Mid(Str(Asc(tru)), 2))
homi = Hex(heni)
b(hic) = homi
If Len(b(hic)) < 2 Then b(hic) = "0" + b(hic)
Next
hist:
outpp = ""
For xxxu = 1 To Len(InString$)
outpp = outpp + b(xxxu)
If xxxu <> Len(InString$) Then outpp = outpp
Next
End Sub
Private Sub datenholennn()
Dim homi, tru, InString As String
Dim ui, xxxu, hic, Starti As Long
Dim heni As Integer
For ui = 1 To 30
a(ui) = ""
b(ui) = ""
Next
Starti = Timer ' Anfangszeit setzen.
nothome:
c1.MSComm1.InputLen = 0
' Prüfen, ob Daten vorhanden sind.
If c1.MSComm1.InBufferCount Then
' Daten lesen.
InString$ = c1.MSComm1.Input
End If
If Timer > Starti + 5 Then GoTo sonne:
If InString$ = "" Then GoTo nothome:
sonne:
For hic = 1 To Len(InString$)
tru = Mid(InString$, hic, 1)
a(hic) = Str(Asc(tru))
heni = Val(Mid(Str(Asc(tru)), 2))
homi = Hex(heni)
b(hic) = homi
If Len(b(hic)) < 2 Then b(hic) = "0" + b(hic)
Next
hist:
outpp = ""
For xxxu = 1 To Len(InString$)
outpp = outpp + b(xxxu)
If xxxu <> Len(InString$) Then outpp = outpp
Next
End Sub
Private Sub forwardtracks_Click()
Dim arg1 As String
arg1 = "21"
c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(arg1) & Chr(&HFF)
End Sub
Private Sub forwars_Click()
Dim arg1 As String
arg1 = "23"
If geraet = &H41 Then c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(arg1) & Chr(&HFF)
If geraet = &H47 Then Cds 2, &H13
Rem ARg1 = "17"
Rem c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(ARg1) & Chr(&HFF)
End Sub
Private Sub nexttracks_Click()
Dim arg1 As String
arg1 = "22"
c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(arg1) & Chr(&HFF)
End Sub
Private Sub stopss_click()
c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(&H6) & Chr(&HFF)
End Sub
Private Sub forwards_Click()
Dim arg1 As String
arg1 = "24"
If geraet = &H41 Then c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(arg1) & Chr(&HFF)
If geraet = &H47 Then Cds 2, &H14
Rem ARg1 = "24"
Rem c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(ARg1) & Chr(&HFF)
End Sub
Private Sub tdisplay_Click()
Cds &H10, &H4
End Sub
Private Sub UserForm_Initialize()
End Sub
Private Sub mdreinladen()
Dim mds(5000)
Dim tonder, suhe, tname, elim, trude, werk, wans, lov As String
Dim xxxx As Long
Dim erfolg, simba, alteposi, pp, trab, marz, xx, coolx As Integer
t1.RichTextBox1.Visible = True
tonder = pfad + "/mddatabase/"
xxxx = 0
tname = Dir(tonder + "*.txt")
Do Until tname = ""
xxxx = xxxx + 1
mds(xxxx) = tname
tname = Dir
Loop
mdanzahl = 0
Rem tname = Dir(tonder + "*.txt")
For erfolg = 1 To xxxx
Rem if mds(erfolg)
Rem suhe = Right("000" + Mid(Str(erfolg), 2), 3) + " MD" + ".txt"
Rem tname = Dir(tonder + "*.txt")
Rem Do Until tname = ""
Rem vergleich(anzahl) = tname
Rem anzahl = anzahl + 1
If Mid(mds(erfolg), 5, 2) = "MD" And Len(mds(erfolg)) = 10 Then
mdanzahl = mdanzahl + 1
t1.RichTextBox1.Text = ""
t1.RichTextBox1.LoadFile tonder + mds(erfolg), 1
For simba = 1 To 280
dilan(simba) = ""
Next
simba = 1
elim = "1"
trude = t1.RichTextBox1.Text
alteposi = 1
For pp = 1 To Len(trude)
lov = Mid(trude, pp, 1)
If lov = Chr(13) Then
werk = Mid(trude, alteposi, pp - alteposi)
alteposi = pp
wans = ""
For trab = 1 To Len(werk)
If Asc(Mid(werk, trab, 1)) <> 13 And Asc(Mid(werk, trab, 1)) <> 10 Then wans = wans + Mid(werk, trab, 1)
Next
dilan(simba) = wans
simba = simba + 1
marz = 1
For xx = 1 To 255
player(1, mdanzahl, xx) = ""
playerzeit(1, mdanzahl, xx) = ""
Next
For coolx = 1 To (simba - 4 / 2)
player(1, mdanzahl, coolx) = dilan(marz + 3)
marz = marz + 1
playerzeit(1, mdanzahl, coolx) = dilan(marz + 3)
marz = marz + 1
Next
playermore(1, mdanzahl, 1) = Mid(Str(((simba - 4) / 2)), 2)
playermore(1, mdanzahl, 2) = dilan(3)
playermore(1, mdanzahl, 3) = dilan(1)
playermore(1, mdanzahl, 4) = dilan(2)
player(1, mdanzahl, 0) = playermore(1, mdanzahl, 3)
End If
Next
tname = ""
End If
Rem tname = Dir
Rem Loop
Next
Rem t1.RichTextBox1.Visible = False
End Sub
Private Sub reinlanden()
Dim tonder, suhe, tname, trude, wans, werk, lov, elim As String
Dim erfolg, simba, alteposi, pp, trab, marz, xx, coolx As Integer
t1.RichTextBox1.Visible = True
tonder = pfad + "/cddatabase/"
For erfolg = 1 To 200
suhe = Right("000" + Mid(Str(erfolg), 2), 3) + " CD" + ".txt"
tname = Dir(tonder + "*.txt")
Do Until tname = ""
Rem vergleich(anzahl) = tname
Rem anzahl = anzahl + 1
If UCase(tname) = UCase(suhe) Then
t1.RichTextBox1.Text = ""
t1.RichTextBox1.LoadFile tonder + suhe, 1
For simba = 1 To 280
dilan(simba) = ""
Next
simba = 1
elim = "1"
trude = t1.RichTextBox1.Text
alteposi = 1
For pp = 1 To Len(trude)
lov = Mid(trude, pp, 1)
If lov = Chr(13) Then
werk = Mid(trude, alteposi, pp - alteposi)
alteposi = pp
wans = ""
For trab = 1 To Len(werk)
If Asc(Mid(werk, trab, 1)) <> 13 And Asc(Mid(werk, trab, 1)) <> 10 Then wans = wans + Mid(werk, trab, 1)
Next
dilan(simba) = wans
simba = simba + 1
marz = 1
For xx = 1 To 255
player(0, erfolg - 1, xx) = ""
playerzeit(0, erfolg - 1, xx) = ""
Next
For coolx = 1 To (simba - 4 / 2)
player(0, erfolg - 1, coolx) = dilan(marz + 3)
marz = marz + 1
playerzeit(0, erfolg - 1, coolx) = dilan(marz + 3)
marz = marz + 1
Next
playermore(0, erfolg - 1, 1) = Mid(Str(((simba - 4) / 2)), 2)
playermore(0, erfolg - 1, 2) = dilan(3)
playermore(0, erfolg - 1, 3) = dilan(1)
playermore(0, erfolg - 1, 4) = dilan(2)
player(0, erfolg - 1, 0) = playermore(0, erfolg - 1, 4) + " - " + playermore(0, erfolg - 1, 3)
End If
Next
tname = ""
End If
tname = Dir
Loop
Next
End Sub
Sub aumwand(wort)
Dim lisi As String
Dim xa, xp As Integer
lisi = ""
For xp = 1 To Len(wort)
xa = Mid(wort, xp, 1)
If xa = "ª" Then xa = "\"
If xa = "¤" Then xa = "/"
If xa = "Þ" Then xa = "*"
If xa = "¿" Then xa = "?"
If xa = "ð" Then xa = Chr(34)
If xa = "Ø" Then xa = "<"
If xa = "¹" Then xa = ">"
If xa = "Ë" Then xa = "|"
If xa = "×" Then xa = ":"
lisi = lisi + xa
Next
umwanderg = lisi
End Sub
Sub umwand(wort)
Dim lisi, xa As String
Dim xp As Integer
lisi = ""
For xp = 1 To Len(wort)
xa = Mid(wort, xp, 1)
If xa = "\" Then xa = "ª"
If xa = "/" Then xa = "¤"
If xa = "*" Then xa = "Þ"
If xa = "?" Then xa = "¿"
If xa = Chr(34) Then xa = "ð"
If xa = "<" Then xa = "Ø"
If xa = ">" Then xa = "¹"
If xa = "|" Then xa = "Ë"
If xa = ":" Then xa = "×"
lisi = lisi + xa
Next
umwanderg = lisi
End Sub
Private Sub laufwbestimmen()
Dim leger, dub, dub2, dub1, dub3, oha As Integer
Dim samie, tig, fixnetzwerklaufwerk, labdavor As String
Dim wert1, wert2, laba As String
Dim Mldg As String
Dim Titel As String
Dim Voreinstellung As String
leger = 0
samie = Dir("C:/Windows/")
While samie <> ""
If UCase(Left(samie, 9)) = "«CDMDCAT»" Then
leger = 1
wert1 = UCase(Mid(samie, 10))
wert1 = Left(wert1, Len(wert1) - 4)
GoTo hemd:
End If
samie = Dir
Wend
If leger = 0 Then
Mldg = "Bitte geben Sie den Pfad Ihres MD/CD-Programms ein:" ' Aufforderung festlegen.
Titel = "Neuinstallation" ' Titel festlegen.
Voreinstellung = "C:/center" ' Voreinstellung festlegen.
' Meldung, Titel und Standardwert anzeigen.
wert1 = InputBox(Mldg, Titel, Voreinstellung)
Rem Documents.Add DocumentType:=wdNewBlankDocument
Rem Selection.TypeText Text:=wert1
Rem error/problem
wert2 = wert1
umwand (wert1)
wert1 = umwanderg
laba = wert2
dub1 = InStr(1, laba, "\")
dub2 = InStr(1, laba, "/")
dub3 = 0
If dub1 > 0 And dub1 < dub2 Then dub3 = dub1
If dub2 > 0 And dub2 >= dub1 Then dub3 = dub2
oha = dub3
If oha < 1 Then GoTo fin:
labdavor = Mid(laba, 1, oha)
laba = Mid(laba, oha + 1)
schleipfe:
dub1 = InStr(1, laba, "\")
dub2 = InStr(1, laba, "/")
dub3 = 0
If dub1 > 0 And dub1 < dub2 Then dub3 = dub1
If dub2 > 0 And dub2 >= dub1 Then dub3 = dub2
If dub3 > 1 Then
ChDir labdavor
tig = Mid(laba, 1, dub3 - 1)
pfad = labdavor
rsmachen (tig)
labdavor = labdavor + Mid(laba, 1, dub3)
laba = Mid(laba, dub3 + 1)
GoTo schleipfe:
End If
ChDir labdavor
tig = laba
pfad = labdavor + laba
rsmachen (tig)
pfad = labdavor + laba
ChDir pfad
rsmachen ("cddatabase")
ChDir pfad
rsmachen ("mddatabase")
ChDir "C:/Windows/"
t1.RichTextBox1.Text = ""
t1.RichTextBox1.SaveFile "«CDMDcat»" + wert1 + ".doc", 1
Rem ActiveDocument.SaveAs FileName:="«CDMDcat»" + wert1 + ".doc", FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
Rem ActiveWindow.Close wdDoNotSaveChanges
Rem rsmachen()
Rem textemachen
End If
hemd:
aumwand (wert1)
wert1 = umwanderg
fixnetzwerklaufwerk = wert1
fin:
pfad = fixnetzwerklaufwerk
End Sub
Private Sub rsmachen(humi)
Dim libi As String
On Error GoTo house:
libi = humi
MkDir libi
GoTo ends:
house:
ends:
End Sub
Private Sub tomi_Click()
Dim itt, power, itt1, itt1a, itta, Min, ind, sec, fip, fips, TrackNumber, tracknumber1 As String
If geraet = &H41 Then
Rem 0x90 0x0C 0x05 0xYZ 0x20 0x20 0x01 0xC0 0x00 DSK TRK 0xFF
Rem DSK = disk number, TRK = track number
Rem timeon
sami "810705410710FF"
Rem 0x90 0x0B 0x05 0xYZ 0x20 0x51 TRK IND MIN SEC 0xFF
Rem TRK = track number, IND = index number, MIN = m
Ich kann auch den Tuner und die Laustärke bedienen.
hier ist der code
Option Explicit
Public speich
Public mdanzahl
Public geraet
Public umwanderg
Public tocenn
Private b(10000)
Private a(10000)
Private player(1, 255, 2000)
Private playerzeit(1, 255, 2000)
Private playermore(1, 255, 10)
Private outpp
Private changcd
Private changezehn
Private suchergebnis(2, 10000)
Private fixspeichern
Private altesbild
Private dilan(280)
Private matrix(2, 260)
Private vergleich(1000)
Private cdform(256)
Private goofy
Private evigfile
Private gift
' ----------------------------------------------
' * MouseEvent Related Declares *
' ----------------------------------------------
Private Const MOUSEEVENTF_ABSOLUTE = &H8000
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
Private Const MOUSEEVENTF_MOVE = &H1
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, _
ByVal dx As Long, ByVal dy As Long, ByVal cbuttons As Long, _
ByVal dwExtraInfo As Long)
' ----------------------------------------------
' * GetSystemMetrics Related Declares *
' ----------------------------------------------
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Const TWIPS_PER_INCH = 1440
Private Const POINTS_PER_INCH = 72
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex _
As Long) As Long
' ----------------------------------------------
' * GetWindowRect Related Declares *
' ----------------------------------------------
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
lpRect As RECT) As Long
' ----------------------------------------------
' * Internal Constants and Types *
' ----------------------------------------------
Private Const MOUSE_MICKEYS = 65535
Public Enum enReportStyle
rsPixels
rsTwips
rsInches
rsPoints
End Enum
Public Enum enButtonToClick
btcLeft
btcRight
btcMiddle
End Enum
Public jetzt
Public pfad
Dim isReg As Boolean
Rem Dim ops As c1.CddbOptions
Dim ops As CddbOptions
Dim proxy As Variant
' Returns the screen size in pixels or, optionally,
' in others scalemode styles
Public Sub GetScreenRes(ByRef X As Long, ByRef Y As Long, Optional ByVal _
ReportStyle As enReportStyle)
X = GetSystemMetrics(SM_CXSCREEN)
Y = GetSystemMetrics(SM_CYSCREEN)
If Not IsMissing(ReportStyle) Then
If ReportStyle <> rsPixels Then
X = X * Screen.TwipsPerPixelX
Y = Y * Screen.TwipsPerPixelY
If ReportStyle = rsInches Or ReportStyle = rsPoints Then
X = X \ TWIPS_PER_INCH
Y = Y \ TWIPS_PER_INCH
If ReportStyle = rsPoints Then
X = X * POINTS_PER_INCH
Y = Y * POINTS_PER_INCH
End If
End If
End If
End If
End Sub
Private Sub alltim()
Dim Min, sec, itt, itt1, fip As String
sami "81080547204400FF"
itt = ""
rauff:
datenholennn
itt1 = outpp
itt = itt + itt1
If Right(itt, 2) <> "FF" Then GoTo rauff:
itt = Right(itt,
Min = Right("000" + Mid(Str(Val("&H" + Mid(itt, 1, 2))), 2), 3)
sec = Right("00" + Mid(Str(Val("&H" + Mid(itt, 3, 2))), 2), 2)
fip = Min + ":" + sec
alltime.Text = fip
End Sub
Private Sub alltimess_click()
alltim
End Sub
Private Sub restzeit()
Dim itt, itt1, Min, sec, fip As String
sami "81080547205400FF"
itt = ""
rauff:
datenholennn
itt1 = outpp
itt = itt + itt1
If Right(itt, 2) <> "FF" Then GoTo rauff:
itt = Right(itt, 6)
Min = Right("000" + Mid(Str(Val("&H" + Mid(itt, 1, 2))), 2), 3)
sec = Right("00" + Mid(Str(Val("&H" + Mid(itt, 3, 2))), 2), 2)
fip = Min + ":" + sec
resttime.Text = fip
End Sub
Private Sub auswerten_Click()
auswertenn
End Sub
Private Sub auswertenn()
Dim huha, restsec, restmin, restall, prosent As Long
Dim huhb, meinallessec, meinallesmin, meinalles, huhh As Long
alltim
restzeit
huha = Abs(Val(Mid(MDCAT.alltime.Text, 1, 3))) * 60 + Abs(Val(Right(MDCAT.alltime.Text, 2)))
huhb = Abs(Val(Right(MDCAT.resttime.Text, 2))) + 60 * Abs(Val(Mid(MDCAT.resttime.Text, 1, 3)))
huhh = huha + huhb
alltogether.Text = Mid(Str(Int(huhh / 60)), 2) + ":" + Right("00" + Mid(Str(huhh - (Int(huhh / 60) * 60)), 2, 2), 2)
meinalles = Val(Right(alltogether.Text, 2)) + 60 * Val(Mid(alltogether.Text, 1, 3))
meinallessec = Val(Right(alltogether.Text, 2))
meinallesmin = Val(Mid(alltogether.Text, 1, 3))
meinalles = meinallessec + meinallesmin * 60
restsec = Val(Right(MDCAT.resttime.Text, 2))
restmin = Val(Mid(MDCAT.resttime.Text, 1, 3))
restall = restsec + restmin * 60
prosent = Round((100 / meinalles * restall), 2)
prozentuel.Text = Str(prosent) + " %"
Image11.Width = Image10.Width / 100 * prosent
End Sub
Private Sub bilda()
Dim zoag As String
Image7.Visible = True
On Error GoTo nos:
zoag = playermore(0, MDCAT.cdlist.ListIndex, 2)
If altesbild <> zoag Then
Image7.Visible = True
Image9.Visible = False
If zoag = "" Then GoTo nos
Image7.Picture = LoadPicture(zoag)
altesbild = zoag
GoTo hiob:
End If
GoTo hiob:
nos:
Image7.Visible = False
Image9.Visible = True
hiob:
Rem playermore(0,2,2)
End Sub
Private Sub cdlist_Change()
Dim gaga As String
Dim tim As Integer
If geraet = "65" Then
cdlade.ListIndex = cdlist.ListIndex
gaga = playermore(0, cdlade.ListIndex, 1)
MDtitel.Clear
zeitlist.Clear
inindex.Clear
Rem mdcdname.Text = playermore(0, cdlade.ListIndex, 4) + " - " + playermore(0, cdlade.ListIndex, 3)
mdcdname.Text = playermore(0, cdlade.ListIndex, 4)
MDCAT.cdautor = playermore(0, cdlade.ListIndex, 3)
mdcode.Text = Right("000" + Mid(Str(cdlade.ListIndex + 1), 2), 3)
Cdandsinger.Text = playermore(0, cdlade.ListIndex, 2)
For tim = 1 To gaga
MDtitel.AddItem player(0, cdlade.ListIndex, tim)
zeitlist.AddItem playerzeit(0, cdlade.ListIndex, tim)
inindex.AddItem Right("00" + Mid(Str(tim), 2), 3)
Next
If geraet = "71" Then
cdlade.ListIndex = cdlist.ListIndex
gaga = playermore(1, cdlade.ListIndex, 1)
MDtitel.Clear
zeitlist.Clear
inindex.Clear
Rem mdcdname.Text = playermore(0, cdlade.ListIndex, 4) + " - " + playermore(0, cdlade.ListIndex, 3)
mdcdname.Text = playermore(1, cdlade.ListIndex, 4)
MDCAT.cdautor = playermore(1, cdlade.ListIndex, 3)
mdcode.Text = Right("000" + Mid(Str(cdlade.ListIndex + 1), 2), 3)
Cdandsinger.Text = playermore(0, cdlade.ListIndex, 2)
For tim = 1 To gaga
MDtitel.AddItem player(1, cdlade.ListIndex, tim)
zeitlist.AddItem playerzeit(1, cdlade.ListIndex, tim)
inindex.AddItem Right("00" + Mid(Str(tim), 2), 3)
Next
End If
bilda
End If
End Sub
Private Sub abspeichh_Click()
If geraet = "71" Then
If speich = 1 Then GoTo rueber:
Cds 2, &H2
Rem stop
Cds 2, &H2
Rem Zeiteneinlesen
refreshit
Rem Titel der MD anzeigen
titelermittelnn
Rem Zeitenangaben
auswertenn
Rem MD Titel einlesen
titeleinlesenn
speich = 1
rueber:
absp
End If
If geraet <> "71" Then
absp
End If
End Sub
Private Sub absp()
Dim cd, m, susi, yemen, ida, affe, ego, i As Long
Dim susi2, susi3, evelin, evelin1, toi, fip, sep, evelin2, spcode, spco, topm, tger As String
Rem t1.RichTextBox1.Text = ""
Rem t1.RichTextBox1.SaveFile "«CDMDcat»" + wert1 + ".doc", 1
m = MDCAT.cdlist.ListIndex
cd = 0
If geraet = "71" Then
cd = 1
m = Val(mdcode.Text)
End If
If m <> -1 Then
t1.RichTextBox1.Text = ""
t1.RichTextBox1.SelStart = 0
i = m
playermore(cd, i, 1) = MDCAT.MDtitel.ListCount
playermore(cd, i, 2) = MDCAT.Cdandsinger.Text
playermore(cd, i, 3) = ""
If mdcdname.Text <> " - " Then playermore(cd, i, 3) = mdcdname.Text
playermore(cd, i, 4) = ""
For ego = 1 To MDCAT.MDtitel.ListCount
player(cd, i, ego) = MDCAT.MDtitel.List(ego - 1)
playerzeit(cd, i, ego) = MDCAT.zeitlist.List(ego - 1)
Next
Rem player(0,0,1): Radio Song
Rem playerzeit(0,0,1): 04:16
Load t1
t1.Show
t1.RichTextBox1.Visible = True
t1.RichTextBox1.Text = ""
Rem SendKeys playermore(cd, m, 1), 1
Rem SendKeys "~", 1
toi = playermore(cd, m, 3)
Rem If toi = "" Then toi = "-"
t1.RichTextBox1.SetFocus
t1.RichTextBox1.SelStart = Len(t1.RichTextBox1.Text)
SendKeys toi, 1
SendKeys "~", 1
t1.RichTextBox1.SetFocus
t1.RichTextBox1.SelStart = Len(t1.RichTextBox1.Text)
SendKeys playermore(cd, m, 4), 1
SendKeys "~", 1
If playermore(cd, m, 2) <> "c:\center\pics/bild.jpg" Then SendKeys playermore(cd, m, 2), 1
If playermore(cd, m, 2) = "c:\center\pics/bild.jpg" Then
susi = MDCAT.MDtitel.ListIndex + 1
susi2 = Right("000" + Mid(Str(susi), 2), 3)
susi3 = pfad + "cover\" + susi2 + ".jpg"
playermore(cd, m, 2) = susi3
SendKeys susi3, 1
End If
SendKeys "~", 1
For yemen = 1 To playermore(cd, m, 1)
SendKeys player(cd, m, yemen), 1
SendKeys "~", 1
Rem SendKeys Mid(playerzeit(m, yemen), 1, 2) + ":" + Mid(playerzeit(m, yemen), 3, 2)
SendKeys playerzeit(cd, m, yemen), 1
SendKeys "~", 1
Next
evelin = ""
For affe = 1 To Len(playermore(cd, m, 4))
topm = Mid(playermore(cd, m, 4), affe, 1)
If topm = Chr(34) Then topm = "'"
If topm = "/" Then topm = "Æ"
If topm = ":" Then topm = "Ê"
If topm = ">" Then topm = "Î"
If topm = "<" Then topm = "Ð"
If topm = "/" Then topm = "Õ"
If topm = "|" Then topm = "Ø"
If topm = "?" Then topm = "Ý"
If topm = "*" Then topm = "Þ"
evelin = evelin + topm
Next
evelin1 = evelin
evelin = ""
For affe = 1 To Len(playermore(cd, m, 3))
topm = Mid(playermore(cd, m, 3), affe, 1)
If topm = Chr(34) Then topm = "'"
If topm = "/" Then topm = "Æ"
If topm = ":" Then topm = "Ê"
If topm = ">" Then topm = "Î"
If topm = "<" Then topm = "Ð"
If topm = "/" Then topm = "Õ"
If topm = "|" Then topm = "Ø"
If topm = "?" Then topm = "Ý"
If topm = "*" Then topm = "Þ"
evelin = evelin + topm
Next
evelin2 = evelin
SendKeys "{DEL}", 1
If cd = 1 Then
ChDir pfad + "/mddatabase"
Rem Dateiname...!!!!!
t1.RichTextBox1.SaveFile Right("000" + Mid(Str(m), 2), 3) + " MD" + ".txt", 1
End If
If cd = 0 Then
ChDir pfad + "/cddatabase"
t1.RichTextBox1.SaveFile Right("000" + Mid(Str(m + 1), 2), 3) + " CD" + ".txt", 1
End If
End If
Unload t1
Rem MDCAT.MDtitel.ListIndex = 0
End Sub
Private Sub cdlade_Click()
If cdlade.ListIndex < 0 Then cdlade.ListIndex = 0
If cdlade.ListIndex >= 0 And cdlist.ListCount > 0 Then
cdlist.ListIndex = cdlade.ListIndex
End If
End Sub
Private Sub cdlist_Click()
Dim gaga As Long
Dim tim As Integer
speich = 0
If geraet = "65" Then
cdlade.ListIndex = cdlist.ListIndex
gaga = playermore(0, cdlade.ListIndex, 1)
MDtitel.Clear
zeitlist.Clear
inindex.Clear
mdcdname.Text = playermore(0, cdlade.ListIndex, 4)
MDCAT.cdautor.Text = playermore(0, cdlade.ListIndex, 3)
mdcode.Text = Right("000" + Mid(Str(cdlade.ListIndex + 1), 2), 3)
Cdandsinger.Text = playermore(0, cdlade.ListIndex, 2)
For tim = 1 To gaga
MDtitel.AddItem player(0, cdlade.ListIndex, tim)
zeitlist.AddItem playerzeit(0, cdlade.ListIndex, tim)
inindex.AddItem Right("00" + Mid(Str(tim), 2), 3)
Next
bilda
End If
If geraet = "71" Then
cdlade.ListIndex = cdlist.ListIndex
gaga = playermore(1, cdlade.ListIndex, 1)
MDtitel.Clear
zeitlist.Clear
inindex.Clear
mdcdname.Text = playermore(1, cdlade.ListIndex, 3)
MDCAT.cdautor.Text = playermore(1, cdlade.ListIndex, 3)
mdcode.Text = Right("000" + Mid(Str(cdlade.ListIndex + 1), 2), 3)
Cdandsinger.Text = playermore(1, cdlade.ListIndex, 2)
For tim = 1 To gaga
MDtitel.AddItem player(1, cdlade.ListIndex, tim)
zeitlist.AddItem playerzeit(1, cdlade.ListIndex, tim)
inindex.AddItem Right("00" + Mid(Str(tim), 2), 3)
Next
bilda
End If
End Sub
Private Sub CheckBox1_Click()
If CheckBox1.Value = 1 Then
oplay.Visible = False
End If
If CheckBox1.Value = 0 Then
oplay.Visible = True
End If
End Sub
Private Sub Einlesen_Click()
If MDCAT.OptionButton1.Value = True Then
Rem stop
Cds 2, &H2
Rem Zeiteneinlesen
refreshit
Rem Titel der MD anzeigen
titelermittelnn
Rem Zeitenangaben
auswertenn
Rem MD Titel einlesen
titeleinlesenn
speich = 1
End If
If MDCAT.OptionButton2.Value = True Then
Rem CD ist nun dran
End If
End Sub
Private Sub inindex_Change()
MDtitel.ListIndex = MDCAT.inindex.ListIndex
End Sub
Private Sub inindex_Click()
MDtitel.ListIndex = MDCAT.inindex.ListIndex
End Sub
Private Sub inindex_DblClick()
MDtitel.ListIndex = MDCAT.inindex.ListIndex
playdoppelclick
End Sub
Private Sub ScrollBar1_Change()
End Sub
Private Sub zeitit_click()
restzeit
End Sub
' Convert's the mouses coordinate system to
' a pixel position.
Public Function MickeyXToPixel(ByVal mouseX As Long) As Long
Dim X As Long
Dim Y As Long
Dim tX As Single
Dim tmouseX As Single
Dim tMickeys As Single
GetScreenRes X, Y
tX = X
tMickeys = MOUSE_MICKEYS
tmouseX = mouseX
MickeyXToPixel = CLng(tmouseX / (tMickeys / tX))
End Function
' Converts mouse Y coordinates to pixels
Public Function MickeyYToPixel(ByVal mouseY As Long) As Long
Dim X As Long
Dim Y As Long
Dim tY As Single
Dim tmouseY As Single
Dim tMickeys As Single
GetScreenRes X, Y
tY = Y
tMickeys = MOUSE_MICKEYS
tmouseY = mouseY
MickeyYToPixel = CLng(tmouseY / (tMickeys / tY))
End Function
' Converts pixel X coordinates to mickeys
Public Function PixelXToMickey(ByVal pixX As Long) As Long
Dim X As Long
Dim Y As Long
Dim tX As Single
Dim tpixX As Single
Dim tMickeys As Single
GetScreenRes X, Y
tMickeys = MOUSE_MICKEYS
tX = X
tpixX = pixX
PixelXToMickey = CLng((tMickeys / tX) * tpixX)
End Function
' Converts pixel Y coordinates to mickeys
Public Function PixelYToMickey(ByVal pixY As Long) As Long
Dim X As Long
Dim Y As Long
Dim tY As Single
Dim tpixY As Single
Dim tMickeys As Single
GetScreenRes X, Y
tMickeys = MOUSE_MICKEYS
tY = Y
tpixY = pixY
PixelYToMickey = CLng((tMickeys / tY) * tpixY)
End Function
' The function will center the mouse on a window
' or control with an hWnd property. No checking
' is done to ensure that the window is not obscured
' or not minimized, however it does make sure that
' the target is within the boundaries of the
' screen.
Public Function CenterMouseOn(ByVal hwnd As Long) As Boolean
Dim X As Long
Dim Y As Long
Dim maxX As Long
Dim maxY As Long
Dim crect As RECT
Dim rc As Long
GetScreenRes maxX, maxY
rc = GetWindowRect(hwnd, crect)
If rc Then
X = crect.Left + ((crect.Right - crect.Left) / 2)
Y = crect.Top + ((crect.Bottom - crect.Top) / 2)
If (X >= 0 And X <= maxX) And (Y >= 0 And Y <= maxY) Then
MouseMove X, Y
CenterMouseOn = True
Else
CenterMouseOn = False
End If
Else
CenterMouseOn = False
End If
End Function
' Simulates a mouse click
Public Function MouseFullClick(ByVal MBClick As enButtonToClick) As Boolean
Dim cbuttons As Long
Dim dwExtraInfo As Long
Dim mevent As Long
Select Case MBClick
Case btcLeft
mevent = MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP
Case btcRight
mevent = MOUSEEVENTF_RIGHTDOWN Or MOUSEEVENTF_RIGHTUP
Case btcMiddle
mevent = MOUSEEVENTF_MIDDLEDOWN Or MOUSEEVENTF_MIDDLEUP
Case Else
MouseFullClick = False
Exit Function
End Select
mouse_event mevent, 0&, 0&, cbuttons, dwExtraInfo
MouseFullClick = True
End Function
Public Sub MouseMove(ByRef xPixel As Long, ByRef yPixel As Long)
Dim cbuttons As Long
Dim dwExtraInfo As Long
mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, _
PixelXToMickey(xPixel), PixelYToMickey(yPixel), cbuttons, dwExtraInfo
End Sub
Private Sub cdlade_Change()
If cdlade.ListIndex < 0 Then cdlade.ListIndex = 0
If cdlade.ListIndex > 0 Then
cdlist.ListIndex = cdlade.ListIndex
End If
End Sub
Private Sub CheckBox1_Change()
If CheckBox1.Value = 1 Then
oplay.Visible = 0
End If
If CheckBox1.Value = 0 Then
oplay.Visible = 1
End If
End Sub
Private Sub CommandButton10_Click()
Cds 1, 2
End Sub
Private Sub titeleinlesenn()
Dim ogatt, start, Mac, tvcinq, stel, ton, stega As Integer
Dim zw, pipa, positionn, hexy, itt1, itt, tittext, timuxxx, wog, onkel, muo As String
ReDim auswert(500)
ogatt = MDtitel.ListCount
MDtitel.Clear
MDCAT.inindex.Clear
For Mac = 1 To ogatt
Rem prozentt.Caption = Str(ogatt - Mac) + " %"
pipa = Hex(Mac)
positionn = Right("000" + pipa, 2)
zw = "20"
hexy = "4E"
Rem sami "810905YZ2045DSKTRK 0xFF"
sami "81090547" + zw + hexy + positionn + "00FF"
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 0.5
Loop
itt = ""
nichtfertig:
trackdateholennn
itt1 = outpp
If itt1 = "" Or itt1 = "900705472086FF" Then
Rem Titel hat keinen Namen
tittext = "-"
GoTo haha:
End If
itt = itt + itt1
Rem If Right(itt1, 4) <> "00FF" And Right(itt1, 4) <> "20FF" Then
If Right(itt1, 4) <> "00FF" Then
GoTo nichtfertig:
End If
onkel = itt
tvcinq = 1
schleife:
stel = InStr(1, onkel, "FF")
If (stel / 2) = Int(stel / 2) Then
stel = InStr(stel + 1, onkel, "FF")
End If
If stel > 0 Then
auswert(tvcinq) = Mid(onkel, 1, stel - 1)
If (stel + 2) < Len(onkel) Then
onkel = Mid(onkel, stel + 2)
tvcinq = tvcinq + 1
GoTo schleife
End If
End If
itt = ""
For ton = 1 To tvcinq
If Mid(auswert(ton), 11, 2) = "5B" Or Mid(auswert(ton), 11, 2) = "5A" Then
itt = itt + Mid(auswert(ton), 15)
End If
Next
wog = itt
tittext = ""
For stega = 1 To (Len(wog) - 2) / 2
muo = Mid(wog, stega * 2 - 1, 2)
timuxxx = "&H" + muo
Rem muo muss von hex in Dec umgewandelt werden
If muo <> "00" Then tittext = tittext + Chr("&H" + muo)
Next
haha:
MDtitel.AddItem tittext
MDCAT.inindex.AddItem Right("000" + Mid(Str(Mac), 2), 3)
Next
Rem prozentt.Visible = False
End Sub
Private Sub CommandButton18_Click()
titeleinlesenn
End Sub
Private Sub CommandButton19_Click()
Dim tgg, TrackNumber, args, trackname As String
Dim sigi, hem, iga As Integer
TrackNumber = "01"
sigi = 0
args = Chr(Hex(1))
Rem stopstop
Rem iga = Val(TextBox1.Text)
tgg = ""
For hem = 0 To 13
tgg = tgg + Chr(hem + iga)
Rem tgg = tgg + Chr(Hex(Mid(Str(iga + hem), 2)))
trackname = tgg
Next
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(TrackNumber) & Chr(0) & Chr(0) & Left(Mid(trackname, 1, 14) & String(14, Chr(&H0)), 14) & Chr(&HFF)
End Sub
Private Sub mdcdname_AfterUpdate()
Dim TrackNumber, start, sigi As Integer
Dim zahl, trackname, args As String
TrackNumber = 0
zahl = ""
On Error GoTo honi:
zahl = mdcdname.Text
honi:
If mdcode.Text <> "" Then zahl = zahl + " Æ" + mdcode.Text + "Æ"
trackname = zahl
silfi:
If trackname <> "" Then
'MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(&H1) & Chr(0) & Chr(0) & "helo" & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&HFF)
Rem c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(TrackNumber) & Chr(0) & Chr(0) & Left(TrackName & String(14, Chr(&H0)), 14) & Chr(&HFF)
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(TrackNumber) & Chr(0) & Chr(0) & Left(Mid(trackname, 1, 14) & String(14, Chr(&H0)), 14) & Chr(&HFF)
For sigi = 1 To (Len(trackname) / 16)
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 1
Loop
args = Chr(Hex(sigi + 1))
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9B) & args & Left(Mid(trackname, (sigi * 16) - 1) & String(16, Chr(&H0)), 16) & Chr(&HFF)
Next
End If
End Sub
Private Sub mdcdname_Exit()
End Sub
Private Sub welchesgeraet()
Dim xxa, start, tvcinq, ton, stega, timuxxx As Integer
Dim zw, itt1, onkel, hexy, itt, wog, stel, muo, tittext As String
ReDim auswert(500)
xxa = Hex(geraet)
zw = "20"
hexy = "22"
sami "810905" + xxa + zw + hexy + "0100FF"
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 0.5
Loop
itt = ""
nichtfertig:
trackdateholennn
Rem cobra
Rem 900705472085FF
itt1 = outpp
itt = itt + itt1
If Right(itt1, 4) <> "00FF" Then
GoTo nichtfertig:
End If
onkel = itt
tvcinq = 1
schleife:
stel = InStr(1, onkel, "FF")
If (stel / 2) = Int(stel / 2) Then
stel = InStr(stel + 1, onkel, "FF")
End If
If stel > 0 Then
auswert(tvcinq) = Mid(onkel, 1, stel - 1)
If (stel + 2) < Len(onkel) Then
onkel = Mid(onkel, stel + 2)
tvcinq = tvcinq + 1
GoTo schleife
End If
End If
itt = ""
For ton = 1 To tvcinq
If Mid(auswert(ton), 11, 2) = "22" Then
itt = itt + Mid(auswert(ton), 13)
End If
Next
wog = itt
tittext = ""
For stega = 1 To (Len(wog) - 2) / 2
muo = Mid(wog, stega * 2 - 1, 2)
timuxxx = "&H" + muo
Rem muo muss von hex in Dec umgewandelt werden
If muo <> "00" Then tittext = tittext + Chr("&H" + muo)
Next
haha:
geraetcod.Caption = tittext
End Sub
Private Sub titelermittelnn()
ReDim auswert(500)
Dim Antwort As String
Dim zw, muo, titext, wog, timuxxx, onkel, itt1, tittext, itt, hexy As String
Dim stel, tipos2, tipos1, stega, ton, start, tvcinq As Integer
zw = "20"
hexy = "4D"
sami "81090547" + zw + hexy + "0100FF"
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 0.5
Loop
itt = ""
nichtfertig:
trackdateholennn
Rem cobra
Rem 900705472085FF
itt1 = outpp
itt = itt + itt1
If itt1 = "" Or itt1 = "900705472085FF" Then
Rem Titel hat keinen Namen
tittext = "no Trackname"
GoTo haha:
End If
Rem itt = itt + itt1
If Right(itt1, 4) <> "00FF" Then
Rem If Right(itt1, 4) <> "00FF" And Right(itt1, 4) <> "20FF" Then
GoTo nichtfertig:
End If
onkel = itt
tvcinq = 1
schleife:
stel = InStr(1, onkel, "FF")
If (stel / 2) = Int(stel / 2) Then
stel = InStr(stel + 1, onkel, "FF")
End If
If stel > 0 Then
auswert(tvcinq) = Mid(onkel, 1, stel - 1)
If (stel + 2) < Len(onkel) Then
onkel = Mid(onkel, stel + 2)
tvcinq = tvcinq + 1
GoTo schleife
End If
End If
itt = ""
For ton = 1 To tvcinq
If Mid(auswert(ton), 11, 2) = "58" Or Mid(auswert(ton), 11, 2) = "59" Then
itt = itt + Mid(auswert(ton), 15)
End If
Next
wog = itt
tittext = ""
For stega = 1 To (Len(wog) - 2) / 2
muo = Mid(wog, stega * 2 - 1, 2)
timuxxx = "&H" + muo
Rem muo muss von hex in Dec umgewandelt werden
If muo <> "00" Then tittext = tittext + Chr("&H" + muo)
Next
haha:
mdcode.Text = ""
tipos1 = 0
tipos2 = 0
tipos1 = InStr(1, tittext, "Æ")
If tipos1 > 0 Then tipos2 = InStr(1, Mid(tittext, tipos1 + 1), "Æ")
If tipos1 > 0 And tipos2 > 0 Then
mdcode.Text = Mid(tittext, tipos1 + 1, tipos2 - 1)
tittext = Mid(tittext, 1, tipos1 - 1) + Mid(tittext, tipos1 + tipos2 + 1)
Else
Rem nun muss eine neu MD-Zahl vergeben werden
Antwort = MsgBox("New MD,...", , "Error") ' Meldung anzeigen.
End If
mdcdname.Text = ""
mdcdname.Text = tittext
If tittext = "" Then
titext = "no Trackname"
mdcdname.Text = titext
End If
End Sub
Private Sub discnameedit()
Dim TrackNumber, sigi, start As Long
Dim zahl As String
Dim trackname, args As String
TrackNumber = 0
zahl = ""
On Error GoTo honi:
zahl = mdcdname.Text
honi:
If mdcode.Text <> "" Then zahl = zahl + " Æ" + mdcode.Text + "Æ"
trackname = zahl
silfi:
If trackname <> "" Then
'MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(&H1) & Chr(0) & Chr(0) & "helo" & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&HFF)
Rem c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(TrackNumber) & Chr(0) & Chr(0) & Left(TrackName & String(14, Chr(&H0)), 14) & Chr(&HFF)
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(TrackNumber) & Chr(0) & Chr(0) & Left(Mid(trackname, 1, 14) & String(14, Chr(&H0)), 14) & Chr(&HFF)
For sigi = 1 To (Len(trackname) / 16)
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 1
Loop
args = Chr(Hex(sigi + 1))
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9B) & args & Left(Mid(trackname, (sigi * 16) - 1) & String(16, Chr(&H0)), 16) & Chr(&HFF)
Next
End If
End Sub
Private Sub mdcdname_LostFocus()
If OptionButton1.Value = True Then discnameedit
End Sub
Private Sub Option1_Click()
On Error GoTo jam:
If Option1.Value = True Then c1.MSComm1.CommPort = 1
jam:
End Sub
Private Sub Option2_Click()
On Error GoTo jam:
If Option2.Value = True Then c1.MSComm1.CommPort = 2
jam:
End Sub
Private Sub Option3_Click()
On Error GoTo jam:
If Option3.Value = True Then c1.MSComm1.CommPort = 3
jam:
End Sub
Private Sub Option4_Click()
On Error GoTo jam:
If Option4.Value = True Then c1.MSComm1.CommPort = 4
jam:
End Sub
Private Sub OptionButton1_Click()
cdmdchang
End Sub
Private Sub OptionButton2_Click()
cdmdchang
End Sub
Private Sub steuer_Change()
If steuer.Text = "1" Then
Dim arg1 As String
arg1 = "21"
c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(arg1) & Chr(&HFF)
steuer.Text = ""
End If
If steuer.Text = "3" Then
arg1 = "22"
c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(arg1) & Chr(&HFF)
steuer.Text = ""
End If
If steuer.Text = "5" Then
Rem divide?
Rem Rem 0x81 0x08 0x05 0xYZ 0x20 0x44 DSK 0xFF
c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H20) & Chr(&H32) & Chr(&HFF)
steuer.Text = ""
End If
If steuer.Text = "2" Then
Rem 0x02 0x03
c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(&H3) & Chr(&HFF)
steuer.Text = ""
End If
End Sub
Private Sub titelermitteln_click()
titelermittelnn
End Sub
Private Sub CommandButton15_Click()
c1.MSComm1.PortOpen = False
End Sub
Private Sub CommandButton16_Click()
Dim alttocen, trackanzahl, rechenbasis, neuwert, jemi As Integer
Dim tocen, mina, seca As String
Dim Toc As String
refreshit
alttocen = 150
tocen = "150"
trackanzahl = zeitlist.ListCount
For jemi = 1 To trackanzahl
Rem If jemi <> trackanzahl Then tocen = tocen + " "
rechenbasis = alttocen
mina = Left(zeitlist.List(jemi - 1), 2)
seca = Right(zeitlist.List(jemi - 1), 2)
neuwert = rechenbasis + (mina * 60 + seca) * 75 + 152
tocen = tocen + Str(neuwert)
alttocen = neuwert
Next
Rem 150 19502 39829 62181 77333 94810 111912 130589 146341 162993 181895 200497
If tocen = "" Then
MsgBox "You must get a toc to display disc info"
Else
Toc = tocen
tocenn = Toc
On Error GoTo flat:
discinfo1.Show 1
Rem vbModal, Me
GoTo noflat:
flat:
MsgBox ("Leider ist nun ein Fehler aufgetreten")
noflat:
Rem Me.txttoc.Text = ""
End If
End Sub
Private Sub CommandButton17_Click()
Rem sami "811707B0xxFF"
Rem play 00
Rem 810705410240FF
Rem sami "811705B00000FF"
Rem Stop
End Sub
Private Sub ejekt_Click()
If geraet = &H47 Then sami "810705470240FF"
If geraet = &H41 Then sami "810705410240FF"
Rem repeat??? 810C0547202000A8A40100FF
End Sub
Private Sub getname_click()
Dim tracky As Integer
tracky = 1
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H5A) & tracky & Chr(&H1) & Chr(&HFF)
datenholennn
End Sub
Private Sub CommandButton11_Click()
Dim ui As Integer
Rem Cds Val(MDCAT.xxx.Text), Val(yyy.Text)
Rem ui = Val(yyy.Text)
ui = ui + 1
Rem yyy.Text = Mid(Str(ui), 2)
End Sub
Private Sub refreshit()
ReDim traki(256)
ReDim mina(256)
ReDim seca(256)
Dim wieoft As Integer
Dim track, dita, savees, wichtig, trackanzahl, itt As String
Dim disk, trackizeit, tiger, uki, arg2, arg1 As String
disk = "01"
track = "01"
zeitlist.Clear
MDCAT.inindex.Clear
MDtitel.Clear
If OptionButton2.Value = True Then
Rem sami "810705411001FF"
disk = Right("0" + Hex(cdlade.List(cdlade.ListIndex)), 2)
arg1 = Val(disk)
arg2 = Val(track)
Rem c1.MSComm1.Output = Chr(&H81) & Chr(&H9) & Chr(&H5) & Chr(&H41) & Chr(&H3) & Chr(&H42) & Chr(ARg1) & Chr(arg2) & Chr(&HFF)
Rem kuchen
End If
If OptionButton1.Value = True Then sami "810705471001FF"
If OptionButton1.Value = True Then
sami "810905470343" + disk + track + "FF"
End If
If OptionButton2.Value = True Then
sami "810905410343" + disk + track + "FF"
End If
Rem If OptionButton1.Value = True Then c1.MSComm1.Output = Chr(&H81) & Chr(&H9) & Chr(&H5) & Chr(&H47) & Chr(&H3) & Chr(&H42) & Chr(ARg1) & Chr(arg2) & Chr(&HFF)
Rem If OptionButton2.Value = True Then c1.MSComm1.Output = Chr(&H81) & Chr(&H9) & Chr(&H5) & Chr(&H41) & Chr(&H3) & Chr(&H42) & Chr(ARg1) & Chr(arg2) & Chr(&HFF)
oska:
datenholennn
itt = outpp
If Mid(itt, 3, 2) <> "0B" Then GoTo oska
If OptionButton1.Value = True Then
sami "810805472044" + disk + "FF"
End If
If OptionButton2.Value = True Then
sami "810805412044" + disk + "FF"
End If
oska2:
datenholennn
itt = outpp
If Mid(itt, 3, 2) <> "0D" Then GoTo oska2
datenholennn
wichtig = outpp
trackanzahl = Str(CDec("&H" + Mid(wichtig, 1, 2)))
Stop
For wieoft = 1 To trackanzahl
uki = Hex(wieoft)
Rem Right("0" + Hex(deut.ListIndex + 1), 2)
tiger = Right("0" + Hex(wieoft), 2)
If OptionButton1.Value = True Then
sami "810905472045" + disk + tiger + "FF"
End If
If OptionButton2.Value = True Then
sami "810905412045" + disk + tiger + "FF"
End If
nika:
datenholennn
savees = outpp
If Mid(outpp, 3, 2) <> "0B" Then GoTo nika:
datenholennn
dita = outpp
If outpp = "" Then
mina(wieoft) = 0
seca(wieoft) = 10
GoTo segen:
End If
If outpp <> "" Then mina(wieoft) = CDec("&H" + Mid(dita, 1, 2))
seca(wieoft) = 0
If Len(dita) > 2 Then seca(wieoft) = CDec("&H" + Mid(dita, 3, 2))
segen:
Rem dupfbacke
trackizeit = Right("0000" + Mid(Str(mina(wieoft)), 2), 2) + ":" + Right("0000" + Mid(Str(seca(wieoft)), 2), 2)
zeitlist.AddItem trackizeit
MDtitel.AddItem "Track " + Str(wieoft)
MDCAT.inindex.AddItem Right("000" + Mid(Str(wieoft), 2), 3)
Next
Rem remote ausschalten
If OptionButton1.Value = True Then
sami "810705471002FF"
End If
If OptionButton2.Value = True Then
sami "810705411002FF"
End If
End Sub
Private Sub CommandButton12_Click()
refreshit
restzeit
End Sub
Private Sub tracknameeingeben()
Dim sigi, oga, foxi, start, piksa, figi, pikss As Integer
Dim Mldgg, args, Titelg, Mldg, Titel, Voreinstellung As String
Dim zahl, wert1, trackname, Voreinstellungg As String
Dim TestDaten As Object
Dim TrackNumber As Integer
If OptionButton1.Value = True Then
ReDim mist(256)
If zeitlist.ListIndex < 0 Then TrackNumber = 0
Rem TrackName = suchit.Text
TrackNumber = zeitlist.ListIndex + 1
Rem Set TestDaten = NewDataObject
Rem TestDaten.GetFromClipboard
zahl = ""
On Error GoTo honi:
zahl = TestDaten.GetText(1)
honi:
If TrackNumber = 0 Then
Mldgg = "MD Name" ' Aufforderung festlegen.
Titelg = "Titel der Mini Disc:" ' Titel festlegen.
If zahl = "" Then zahl = ""
Voreinstellungg = zahl ' Voreinstellung festlegen.
' Meldung, Titel und Standardwert anzeigen.
wert1 = InputBox(Mldgg, Titelg, Voreinstellungg)
trackname = wert1
GoTo silfi:
End If
Mldg = "MD Name von Track (" + Mid(Str(TrackNumber), 2) + ")" ' Aufforderung festlegen.
Titel = "Titel des Tracks:" ' Titel festlegen.
If zahl = "" Then zahl = "MD-Name"
Voreinstellung = zahl ' Voreinstellung festlegen.
' Meldung, Titel und Standardwert anzeigen.
wert1 = InputBox(Mldg, Titel, Voreinstellung)
trackname = wert1
silfi:
If trackname <> "" Then
'MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(&H1) & Chr(0) & Chr(0) & "helo" & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&HFF)
Rem c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(TrackNumber) & Chr(0) & Chr(0) & Left(TrackName & String(14, Chr(&H0)), 14) & Chr(&HFF)
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(TrackNumber) & Chr(0) & Chr(0) & Left(Mid(trackname, 1, 14) & String(14, Chr(&H0)), 14) & Chr(&HFF)
For sigi = 1 To (Len(trackname) / 16)
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 1
Loop
args = Chr(Hex(sigi + 1))
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9B) & args & Left(Mid(trackname, (sigi * 16) - 1) & String(16, Chr(&H0)), 16) & Chr(&HFF)
Next
nichtanruehren:
oga = MDtitel.ListIndex
foxi = MDtitel.ListCount
For piksa = 0 To foxi - 1
mist(piksa) = MDtitel.List(piksa)
Next
If oga = -1 Then GoTo heimat:
mist(oga) = trackname
figi = MDtitel.ListIndex
MDtitel.Clear
For pikss = 0 To foxi - 1
MDtitel.AddItem mist(pikss)
Next
MDtitel.ListIndex = figi
End If
End If
If OptionButton2.Value = True Then
cdbenamsen
End If
heimat:
End Sub
Private Sub cdbenamsen()
Dim sigi, oga, foxi, start, piksa, pikss, figi As Integer
Dim Mldgg, args, Titelg, Mldg, Titel, Voreinstellung As String
Dim zahl, wert1, trackname, Voreinstellungg As String
Dim TestDaten As Object
Dim TrackNumber As Integer
ReDim mist(256)
If zeitlist.ListIndex < 0 Then TrackNumber = 0
Rem TrackName = suchit.Text
TrackNumber = zeitlist.ListIndex + 1
Rem Set TestDaten = NewDataObject
Rem TestDaten.GetFromClipboard
zahl = ""
On Error GoTo honi:
zahl = TestDaten.GetText(1)
honi:
If TrackNumber = 0 Then
Mldgg = "MD Name" ' Aufforderung festlegen.
Titelg = "Titel der Mini Disc:" ' Titel festlegen.
If zahl = "" Then zahl = ""
Voreinstellungg = zahl ' Voreinstellung festlegen.
' Meldung, Titel und Standardwert anzeigen.
wert1 = InputBox(Mldgg, Titelg, Voreinstellungg)
trackname = wert1
GoTo silfi:
End If
Mldg = "MD Name von Track (" + Mid(Str(TrackNumber), 2) + ")" ' Aufforderung festlegen.
Titel = "Titel des Tracks:" ' Titel festlegen.
If zahl = "" Then zahl = "MD-Name"
Voreinstellung = zahl ' Voreinstellung festlegen.
' Meldung, Titel und Standardwert anzeigen.
wert1 = InputBox(Mldg, Titel, Voreinstellung)
trackname = wert1
silfi:
If MDCAT.OptionButton2.Value = True Then GoTo nichtanruehren:
If trackname <> "" Then
'MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(&H1) & Chr(0) & Chr(0) & "helo" & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&HFF)
Rem c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(TrackNumber) & Chr(0) & Chr(0) & Left(TrackName & String(14, Chr(&H0)), 14) & Chr(&HFF)
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9A) & Chr(TrackNumber) & Chr(0) & Chr(0) & Left(Mid(trackname, 1, 14) & String(14, Chr(&H0)), 14) & Chr(&HFF)
For sigi = 1 To (Len(trackname) / 16)
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 1
Loop
args = Chr(Hex(sigi + 1))
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9B) & args & Left(Mid(trackname, (sigi * 16) - 1) & String(16, Chr(&H0)), 16) & Chr(&HFF)
Next
nichtanruehren:
oga = MDtitel.ListIndex
foxi = MDtitel.ListCount
For piksa = 0 To foxi - 1
mist(piksa) = MDtitel.List(piksa)
Next
If oga = -1 Then GoTo heimat:
mist(oga) = trackname
figi = MDtitel.ListIndex
MDtitel.Clear
For pikss = 0 To foxi - 1
MDtitel.AddItem mist(pikss)
Next
MDtitel.ListIndex = figi
End If
heimat:
End Sub
Private Sub CommandButton13_Click()
tracknameeingeben
End Sub
Private Sub misttt()
Dim trackname As String
Dim start As Integer
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 1
Loop
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9B) & Chr(&H3) & Left(Mid(trackname, 31) & String(16, Chr(&H0)), 16) & Chr(&HFF)
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 1
Loop
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9B) & Chr(&H4) & Left(Mid(trackname, 47) & String(16, Chr(&H0)), 16) & Chr(&HFF)
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 1
Loop
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9B) & Chr(&H5) & Left(Mid(trackname, 63) & String(16, Chr(&H0)), 16) & Chr(&HFF)
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 1
Loop
c1.MSComm1.Output = Chr(&H81) & Chr(&H17) & Chr(&H7) & Chr(&HB0) & Chr(&H9B) & Chr(&H6) & Left(Mid(trackname, 79) & String(16, Chr(&H0)), 16) & Chr(&HFF)
End Sub
Private Sub CommandButton14_Click()
sami "810C0547202000A8A40100FF"
End Sub
Private Sub CommandButton2_Click()
Dim meinvorgang As Object
Dim tasks As Object
Dim nich As Integer
Dim sutmii As String
For Each meinvorgang In tasks
If meinvorgang.Name = "MD Editor2" = True Then
nich = 1
On Error GoTo oarg:
meinvorgang.Activate
Rem meinVorgang.WindowState = wdWindowStateMaximize
oarg:
End If
Next
If nich = 0 Then
sutmii = Shell(pfad + "MD Editor2/mdeditor2.exe", vbNormalFocus)
End If
End Sub
Private Sub CommandButton3_Click()
Unload MDCAT
End Sub
Private Sub CommandButton4_Click()
Unload MDCAT
End Sub
Private Sub CommandButton6_Click()
Dim pip As String
c1.MSComm1.PortOpen = False
pip = Shell("C:\center\MD Editor2\mdeditor2.exe", vbMinimizedFocus)
End Sub
Private Sub CommandButton7_Click()
Rem MouseMove Val(X2.Text), Val(Y2.Text)
End Sub
Private Sub CommandButton8_Click()
Dim meinvorgang As Object
Dim tasks As Object
Dim nich, start As Integer
Dim sutmii As String
For Each meinvorgang In tasks
If meinvorgang.Name = "MD Editor2" = True Then
nich = 1
On Error GoTo oarg:
meinvorgang.Activate
Rem meinVorgang.WindowState = wdWindowStateMaximize
oarg:
End If
Next
If nich = 0 Then
sutmii = Shell("c:/center/MD Editor2/mdeditor2.exe", vbNormalFocus)
End If
MouseMove 97, 43
MouseFullClick btcLeft
MouseMove 97, 43
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 0.5
Loop
MouseFullClick btcLeft
MouseMove 978, 5
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 0.5
Loop
MouseFullClick btcLeft
MouseMove 97, 43
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 0.5
Loop
MouseFullClick btcLeft
tiber
End Sub
Private Sub tiber()
Dim tasks, meinvorgang, wdWindowStateMaximize As Object
Dim nich As Integer
For Each meinvorgang In tasks
If meinvorgang.Name = "MD Windows" = True Then
nich = 1
On Error GoTo oarg2:
meinvorgang.Activate
meinvorgang.WindowState = wdWindowStateMaximize
oarg2:
End If
Next
End Sub
Private Sub CommandButton9_Click()
Load weblink
weblink.Show
End Sub
Private Sub einlesenn_Click()
Dim tito As String
Dim tit, start, ut As Integer
tiber
MouseMove 90, 100
MouseFullClick btcRight
MouseMove 94, 104
MouseFullClick btcRight
SendKeys "{DEL}", 1
tito = "C:\center\Okt01\Md.csv"
For tit = 1 To Len(tito)
ut = Mid(tito, tit, 1)
SendKeys "{" + ut + "}", 1
Next
SendKeys "{TAB}", 1
SendKeys "{TAB}", 1
SendKeys "~", 1
SendKeys "J", 1
MouseMove 980, 9
MouseFullClick btcLeft
MouseFullClick btcLeft
MouseMove 980, 65
MouseFullClick btcLeft
MouseMove 980, 65
MouseFullClick btcRight
start = Timer ' Anfangszeit setzen.
Do While Timer < start + 1
Loop
SendKeys "K", 1
Rem NUN IST DIE MD abgespeichert und der Titel im Zwischenspeicher
End Sub
Private Sub Cds(arg1 As Integer, arg2 As Integer)
On Error GoTo shit:
If OptionButton1.Value = True Then c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(&H47) & Chr(arg1) & Chr(arg2) & Chr(&HFF)
If OptionButton2.Value = True Then c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(&H41) & Chr(arg1) & Chr(arg2) & Chr(&HFF)
GoTo rub:
shit:
rub:
End Sub
Private Sub fstop_Click()
Cds 2, &H2
End Sub
Private Sub MDtitel_Change()
End Sub
Private Sub MDtitel_Click()
zeitlist.ListIndex = MDtitel.ListIndex
If MDtitel.ListIndex >= 0 And MDCAT.inindex.ListCount >= MDtitel.ListIndex Then MDCAT.inindex.ListIndex = MDtitel.ListIndex
End Sub
Private Sub MDtitel_DblClick()
zeitlist.ListIndex = MDtitel.ListIndex
MDCAT.inindex.ListIndex = MDtitel.ListIndex
playdoppelclick
End Sub
Private Sub mist_Click()
End Sub
Private Sub OptionButton1_Change()
cdmdchang
End Sub
Private Sub cdmdchang()
Dim playerzeiger As Integer
speich = 0
Cds 1, 2
If OptionButton1.Value = True Then
mdcdname.Width = 6975
cdp.Visible = False
geraet = &H47
cdlist.Clear
cdlade.Visible = False
Image7.Visible = False
Image9.Visible = True
Image11.Visible = True
Image10.Visible = True
resttime.Visible = True
prozentuel.Visible = True
alltime.Visible = True
alltogether.Visible = True
Cdandsinger = ""
welchesgeraet
cdlist.Clear
zeitlist.Clear
Rem rumba
For playerzeiger = 1 To mdanzahl
cdlist.AddItem Right("000" + Mid(Str(playerzeiger), 2), 3) + " " + player(1, playerzeiger - 1, 0)
Next
End If
If OptionButton2.Value = True Then
mdcdname.Width = 4455
cdp.Visible = True
Image11.Visible = False
Image10.Visible = False
resttime.Visible = False
prozentuel.Visible = False
alltime.Visible = False
alltogether.Visible = False
geraet = &H41
cdlade.Visible = True
cdlist.Clear
zeitlist.Clear
For playerzeiger = 1 To 200
cdlist.AddItem Right("000" + Mid(Str(playerzeiger), 2), 3) + " " + player(0, playerzeiger - 1, 0)
Next
welchesgeraet
End If
End Sub
Private Sub Form_Load()
' playermore(0,0,1): 11
' playermore(0,0,2): c:\center\\cover\001.jpg
' playermore(0,0,3): R.E.M.
' playermore(0,0,4): Out of Time
' player(0,0,1): Radio Song
' playerzeit(0,0,1): 04:16
Dim xu As Integer
Dim Control As Object
laufwbestimmen
MDCAT.pfadlabel.Caption = pfad
If OptionButton1.Value = True Then geraet = &H47
If OptionButton2.Value = True Then geraet = &H41
Rem pfad = "C:\center\"
eon
For xu = 1 To 200
cdlade.AddItem Right("00" + Mid(Str(xu), 2), 3)
Next
cdlade.ListIndex = 0
Dim isReg As Boolean
Dim ops As CddbOptions
Dim proxy As Variant
' The first call should set the client information within the control
' The CDDBControl object is available on the main form
Set Control = c1.CDDBControl1
' You must set the client ID and Tag to use this application
'Control.SetClientInfo "YourID", "YourTag", "1", "regString"
Rem ClientId 15731712
Rem Tag 8783988761BD5C951BDEA06E03135783
On Error GoTo mistt:
Control.SetClientInfo "15731712", "8783988761BD5C951BDEA06E03135783", "1", "regString"
Rem control.Initialize
c1.CDDBControl1.Initialize hwnd, CACHE_DEFAULT
'Set Options to test submit mode. Change TestSubmitMode to False before releasing your
'application to your users once the application has been validated
Set ops = Control.GetOptions
ops.TestSubmitMode = True
Control.SetOptions ops
'If connecting to the Internet through a proxy, get proxy information
Rem proxy = MsgBox("Are you connecting to the internet through a proxy?", vbYesNo)
Rem If proxy = vbYes Then ProxyInfo.Show vbModal, Me
' If the user is not already registered, bring up the default registration
' dialog. (This is also available through the visible control)
isReg = Control.IsRegistered(0)
If isReg = False Then
isReg = Control.IsRegistered(1)
End If
mistt:
reinlanden
mdreinladen
Cds 1, 2
welchesgeraet
cdmdchang
End Sub
Private Sub OptionButton2_Change()
cdmdchang
End Sub
Private Sub plays_Click()
c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(&H1) & Chr(&HFF)
End Sub
Private Sub eon()
On Error GoTo shit:
Rem c1.MSComm1.CommPort = GetSetting("MP3MDSPC2", "Commport", "COM", "1")
Rem OLGA
If Option1.Value = True Then c1.MSComm1.CommPort = 1
If Option2.Value = True Then c1.MSComm1.CommPort = 2
If Option3.Value = True Then c1.MSComm1.CommPort = 3
If Option4.Value = True Then c1.MSComm1.CommPort = 4
c1.MSComm1.PortOpen = True
shit:
End Sub
Private Sub fplay_Click()
Cds 2, 1
End Sub
Private Sub ftreg_Click()
Cds 2, &H28
End Sub
Private Sub poweroff_Click()
Cds 1, 3
End Sub
Private Sub reg_Click()
Cds 2, &H2
Cds 2, 16
Cds 2, &H21
End Sub
Private Sub spez_Click()
Dim discnummer, arg1, arg2, Tracknummer As Integer
discnummer = 1
Tracknummer = 5
If OptionButton2.Value = True Then discnummer = Right("0" + Hex(cdlade.List(cdlade.ListIndex)), 2)
arg1 = discnummer
arg2 = Tracknummer
Rem c1.MSComm1.Output = Chr(&H81) & Chr(&H9) & Chr(&H5) & Chr(&H41) & Chr(&H3) & Chr(&H42) & Chr(ARg1) & Chr(arg2) & Chr(&HFF)
Rem 0x81 0x09 0x05 0xYZ 0x03 0x42 DSK TRK 0xFF
If OptionButton1.Value = True Then c1.MSComm1.Output = Chr(&H81) & Chr(&H9) & Chr(&H5) & Chr(&H47) & Chr(&H3) & Chr(&H42) & Chr(arg1) & Chr(arg2) & Chr(&HFF)
If OptionButton2.Value = True Then c1.MSComm1.Output = Chr(&H81) & Chr(&H9) & Chr(&H5) & Chr(&H41) & Chr(&H3) & Chr(&H42) & Chr(arg1) & Chr(arg2) & Chr(&HFF)
End Sub
Private Sub sami(uka As String)
Dim Antwort, esi, DADAs, hor As String
Dim tri As Integer
esi = uka
hor = ""
For tri = 1 To (Len(esi) / 2)
DADAs = Mid(esi, tri * 2 - 1, 2)
hor = hor + Chr("&H" + DADAs)
Next
esi = hor
On Error GoTo gucki:
c1.MSComm1.Output = esi
GoTo endend:
gucki:
Antwort = MsgBox("Error: Operation valid only when the port is open", , "Error") ' Meldung anzeigen.
endend:
End Sub
Private Sub trackdateholennn()
Dim ui, Starti, hic, heni, xxxu As Integer
Dim homi As String
Dim InString$, tru As String
For ui = 1 To 30
a(ui) = ""
b(ui) = ""
Next
Starti = Timer ' Anfangszeit setzen.
nothome:
c1.MSComm1.InputLen = 0
' Prüfen, ob Daten vorhanden sind.
If c1.MSComm1.InBufferCount Then
' Daten lesen.
InString$ = c1.MSComm1.Input
End If
If Timer > Starti + 2 Then GoTo sonne:
If InString$ = "" Then GoTo nothome:
sonne:
For hic = 1 To Len(InString$)
tru = Mid(InString$, hic, 1)
a(hic) = Str(Asc(tru))
heni = Val(Mid(Str(Asc(tru)), 2))
homi = Hex(heni)
b(hic) = homi
If Len(b(hic)) < 2 Then b(hic) = "0" + b(hic)
Next
hist:
outpp = ""
For xxxu = 1 To Len(InString$)
outpp = outpp + b(xxxu)
If xxxu <> Len(InString$) Then outpp = outpp
Next
End Sub
Private Sub datenholennn()
Dim homi, tru, InString As String
Dim ui, xxxu, hic, Starti As Long
Dim heni As Integer
For ui = 1 To 30
a(ui) = ""
b(ui) = ""
Next
Starti = Timer ' Anfangszeit setzen.
nothome:
c1.MSComm1.InputLen = 0
' Prüfen, ob Daten vorhanden sind.
If c1.MSComm1.InBufferCount Then
' Daten lesen.
InString$ = c1.MSComm1.Input
End If
If Timer > Starti + 5 Then GoTo sonne:
If InString$ = "" Then GoTo nothome:
sonne:
For hic = 1 To Len(InString$)
tru = Mid(InString$, hic, 1)
a(hic) = Str(Asc(tru))
heni = Val(Mid(Str(Asc(tru)), 2))
homi = Hex(heni)
b(hic) = homi
If Len(b(hic)) < 2 Then b(hic) = "0" + b(hic)
Next
hist:
outpp = ""
For xxxu = 1 To Len(InString$)
outpp = outpp + b(xxxu)
If xxxu <> Len(InString$) Then outpp = outpp
Next
End Sub
Private Sub forwardtracks_Click()
Dim arg1 As String
arg1 = "21"
c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(arg1) & Chr(&HFF)
End Sub
Private Sub forwars_Click()
Dim arg1 As String
arg1 = "23"
If geraet = &H41 Then c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(arg1) & Chr(&HFF)
If geraet = &H47 Then Cds 2, &H13
Rem ARg1 = "17"
Rem c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(ARg1) & Chr(&HFF)
End Sub
Private Sub nexttracks_Click()
Dim arg1 As String
arg1 = "22"
c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(arg1) & Chr(&HFF)
End Sub
Private Sub stopss_click()
c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(&H6) & Chr(&HFF)
End Sub
Private Sub forwards_Click()
Dim arg1 As String
arg1 = "24"
If geraet = &H41 Then c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(arg1) & Chr(&HFF)
If geraet = &H47 Then Cds 2, &H14
Rem ARg1 = "24"
Rem c1.MSComm1.Output = Chr(&H81) & Chr(&H7) & Chr(&H5) & Chr(geraet) & Chr(&H2) & Chr(ARg1) & Chr(&HFF)
End Sub
Private Sub tdisplay_Click()
Cds &H10, &H4
End Sub
Private Sub UserForm_Initialize()
End Sub
Private Sub mdreinladen()
Dim mds(5000)
Dim tonder, suhe, tname, elim, trude, werk, wans, lov As String
Dim xxxx As Long
Dim erfolg, simba, alteposi, pp, trab, marz, xx, coolx As Integer
t1.RichTextBox1.Visible = True
tonder = pfad + "/mddatabase/"
xxxx = 0
tname = Dir(tonder + "*.txt")
Do Until tname = ""
xxxx = xxxx + 1
mds(xxxx) = tname
tname = Dir
Loop
mdanzahl = 0
Rem tname = Dir(tonder + "*.txt")
For erfolg = 1 To xxxx
Rem if mds(erfolg)
Rem suhe = Right("000" + Mid(Str(erfolg), 2), 3) + " MD" + ".txt"
Rem tname = Dir(tonder + "*.txt")
Rem Do Until tname = ""
Rem vergleich(anzahl) = tname
Rem anzahl = anzahl + 1
If Mid(mds(erfolg), 5, 2) = "MD" And Len(mds(erfolg)) = 10 Then
mdanzahl = mdanzahl + 1
t1.RichTextBox1.Text = ""
t1.RichTextBox1.LoadFile tonder + mds(erfolg), 1
For simba = 1 To 280
dilan(simba) = ""
Next
simba = 1
elim = "1"
trude = t1.RichTextBox1.Text
alteposi = 1
For pp = 1 To Len(trude)
lov = Mid(trude, pp, 1)
If lov = Chr(13) Then
werk = Mid(trude, alteposi, pp - alteposi)
alteposi = pp
wans = ""
For trab = 1 To Len(werk)
If Asc(Mid(werk, trab, 1)) <> 13 And Asc(Mid(werk, trab, 1)) <> 10 Then wans = wans + Mid(werk, trab, 1)
Next
dilan(simba) = wans
simba = simba + 1
marz = 1
For xx = 1 To 255
player(1, mdanzahl, xx) = ""
playerzeit(1, mdanzahl, xx) = ""
Next
For coolx = 1 To (simba - 4 / 2)
player(1, mdanzahl, coolx) = dilan(marz + 3)
marz = marz + 1
playerzeit(1, mdanzahl, coolx) = dilan(marz + 3)
marz = marz + 1
Next
playermore(1, mdanzahl, 1) = Mid(Str(((simba - 4) / 2)), 2)
playermore(1, mdanzahl, 2) = dilan(3)
playermore(1, mdanzahl, 3) = dilan(1)
playermore(1, mdanzahl, 4) = dilan(2)
player(1, mdanzahl, 0) = playermore(1, mdanzahl, 3)
End If
Next
tname = ""
End If
Rem tname = Dir
Rem Loop
Next
Rem t1.RichTextBox1.Visible = False
End Sub
Private Sub reinlanden()
Dim tonder, suhe, tname, trude, wans, werk, lov, elim As String
Dim erfolg, simba, alteposi, pp, trab, marz, xx, coolx As Integer
t1.RichTextBox1.Visible = True
tonder = pfad + "/cddatabase/"
For erfolg = 1 To 200
suhe = Right("000" + Mid(Str(erfolg), 2), 3) + " CD" + ".txt"
tname = Dir(tonder + "*.txt")
Do Until tname = ""
Rem vergleich(anzahl) = tname
Rem anzahl = anzahl + 1
If UCase(tname) = UCase(suhe) Then
t1.RichTextBox1.Text = ""
t1.RichTextBox1.LoadFile tonder + suhe, 1
For simba = 1 To 280
dilan(simba) = ""
Next
simba = 1
elim = "1"
trude = t1.RichTextBox1.Text
alteposi = 1
For pp = 1 To Len(trude)
lov = Mid(trude, pp, 1)
If lov = Chr(13) Then
werk = Mid(trude, alteposi, pp - alteposi)
alteposi = pp
wans = ""
For trab = 1 To Len(werk)
If Asc(Mid(werk, trab, 1)) <> 13 And Asc(Mid(werk, trab, 1)) <> 10 Then wans = wans + Mid(werk, trab, 1)
Next
dilan(simba) = wans
simba = simba + 1
marz = 1
For xx = 1 To 255
player(0, erfolg - 1, xx) = ""
playerzeit(0, erfolg - 1, xx) = ""
Next
For coolx = 1 To (simba - 4 / 2)
player(0, erfolg - 1, coolx) = dilan(marz + 3)
marz = marz + 1
playerzeit(0, erfolg - 1, coolx) = dilan(marz + 3)
marz = marz + 1
Next
playermore(0, erfolg - 1, 1) = Mid(Str(((simba - 4) / 2)), 2)
playermore(0, erfolg - 1, 2) = dilan(3)
playermore(0, erfolg - 1, 3) = dilan(1)
playermore(0, erfolg - 1, 4) = dilan(2)
player(0, erfolg - 1, 0) = playermore(0, erfolg - 1, 4) + " - " + playermore(0, erfolg - 1, 3)
End If
Next
tname = ""
End If
tname = Dir
Loop
Next
End Sub
Sub aumwand(wort)
Dim lisi As String
Dim xa, xp As Integer
lisi = ""
For xp = 1 To Len(wort)
xa = Mid(wort, xp, 1)
If xa = "ª" Then xa = "\"
If xa = "¤" Then xa = "/"
If xa = "Þ" Then xa = "*"
If xa = "¿" Then xa = "?"
If xa = "ð" Then xa = Chr(34)
If xa = "Ø" Then xa = "<"
If xa = "¹" Then xa = ">"
If xa = "Ë" Then xa = "|"
If xa = "×" Then xa = ":"
lisi = lisi + xa
Next
umwanderg = lisi
End Sub
Sub umwand(wort)
Dim lisi, xa As String
Dim xp As Integer
lisi = ""
For xp = 1 To Len(wort)
xa = Mid(wort, xp, 1)
If xa = "\" Then xa = "ª"
If xa = "/" Then xa = "¤"
If xa = "*" Then xa = "Þ"
If xa = "?" Then xa = "¿"
If xa = Chr(34) Then xa = "ð"
If xa = "<" Then xa = "Ø"
If xa = ">" Then xa = "¹"
If xa = "|" Then xa = "Ë"
If xa = ":" Then xa = "×"
lisi = lisi + xa
Next
umwanderg = lisi
End Sub
Private Sub laufwbestimmen()
Dim leger, dub, dub2, dub1, dub3, oha As Integer
Dim samie, tig, fixnetzwerklaufwerk, labdavor As String
Dim wert1, wert2, laba As String
Dim Mldg As String
Dim Titel As String
Dim Voreinstellung As String
leger = 0
samie = Dir("C:/Windows/")
While samie <> ""
If UCase(Left(samie, 9)) = "«CDMDCAT»" Then
leger = 1
wert1 = UCase(Mid(samie, 10))
wert1 = Left(wert1, Len(wert1) - 4)
GoTo hemd:
End If
samie = Dir
Wend
If leger = 0 Then
Mldg = "Bitte geben Sie den Pfad Ihres MD/CD-Programms ein:" ' Aufforderung festlegen.
Titel = "Neuinstallation" ' Titel festlegen.
Voreinstellung = "C:/center" ' Voreinstellung festlegen.
' Meldung, Titel und Standardwert anzeigen.
wert1 = InputBox(Mldg, Titel, Voreinstellung)
Rem Documents.Add DocumentType:=wdNewBlankDocument
Rem Selection.TypeText Text:=wert1
Rem error/problem
wert2 = wert1
umwand (wert1)
wert1 = umwanderg
laba = wert2
dub1 = InStr(1, laba, "\")
dub2 = InStr(1, laba, "/")
dub3 = 0
If dub1 > 0 And dub1 < dub2 Then dub3 = dub1
If dub2 > 0 And dub2 >= dub1 Then dub3 = dub2
oha = dub3
If oha < 1 Then GoTo fin:
labdavor = Mid(laba, 1, oha)
laba = Mid(laba, oha + 1)
schleipfe:
dub1 = InStr(1, laba, "\")
dub2 = InStr(1, laba, "/")
dub3 = 0
If dub1 > 0 And dub1 < dub2 Then dub3 = dub1
If dub2 > 0 And dub2 >= dub1 Then dub3 = dub2
If dub3 > 1 Then
ChDir labdavor
tig = Mid(laba, 1, dub3 - 1)
pfad = labdavor
rsmachen (tig)
labdavor = labdavor + Mid(laba, 1, dub3)
laba = Mid(laba, dub3 + 1)
GoTo schleipfe:
End If
ChDir labdavor
tig = laba
pfad = labdavor + laba
rsmachen (tig)
pfad = labdavor + laba
ChDir pfad
rsmachen ("cddatabase")
ChDir pfad
rsmachen ("mddatabase")
ChDir "C:/Windows/"
t1.RichTextBox1.Text = ""
t1.RichTextBox1.SaveFile "«CDMDcat»" + wert1 + ".doc", 1
Rem ActiveDocument.SaveAs FileName:="«CDMDcat»" + wert1 + ".doc", FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
Rem ActiveWindow.Close wdDoNotSaveChanges
Rem rsmachen()
Rem textemachen
End If
hemd:
aumwand (wert1)
wert1 = umwanderg
fixnetzwerklaufwerk = wert1
fin:
pfad = fixnetzwerklaufwerk
End Sub
Private Sub rsmachen(humi)
Dim libi As String
On Error GoTo house:
libi = humi
MkDir libi
GoTo ends:
house:
ends:
End Sub
Private Sub tomi_Click()
Dim itt, power, itt1, itt1a, itta, Min, ind, sec, fip, fips, TrackNumber, tracknumber1 As String
If geraet = &H41 Then
Rem 0x90 0x0C 0x05 0xYZ 0x20 0x20 0x01 0xC0 0x00 DSK TRK 0xFF
Rem DSK = disk number, TRK = track number
Rem timeon
sami "810705410710FF"
Rem 0x90 0x0B 0x05 0xYZ 0x20 0x51 TRK IND MIN SEC 0xFF
Rem TRK = track number, IND = index number, MIN = m
