Poll
Question:
besteht intresse daran dann werde ich weider arbeiten
Option 1: soll ich daran bleiben
votes: 1
Option 2: soll ich es löschen
votes: 0
Habe wieder mal was aufgearbeitet für PBwin 10 werde den Quellcode in den Nächsten Tagen veröffentlichen. Muss noch ein paar Sachen aufarbeiten. ist ein COM Objekt lässt sich von Excel und Word aufrufen, geht aber auch eigenständig! Hiermit lässt sich eine Audio CD auslesen und eine CD Datenbank erstellen. Das Objekt ließt automatisch aus dem Internet Titel einer CD
Den Quellcode habe ich dazu gepackt!
Grüße Peter
Google translation:
QuoteHave again what worked for PBwin 10 will release the source code in the next days. Still needs a few things worked up. is a COM object can be called from Excel and Word, but is also independently! This allows to read an audio CD and create a CD database. The object reads from the Internet automatically tracks on a CD
QuoteSo here's the source code
Hallo
Um das Objekt in Excel oder Word zu nutzen muss folgendes Programm als Administrator ausgeführt werden
'------------------------------------------------------------------------------
'
' Register the pbfree.dll COM Server
' Copyright (c) 2014 Peter Weis
' All Rights Reserved.
'
'
'------------------------------------------------------------------------------
#COMPILE EXE
#DIM ALL
DECLARE FUNCTION DllRegisterServer LIB ".\pbfreedb.dll" ALIAS "DllRegisterServer" AS LONG
FUNCTION PBMAIN () AS LONG
LOCAL i AS LONG
i = DllRegisterServer
IF i = %S_OK THEN
? "Registration of PBFREEDB.dll was successful"
ELSE
? "Registration of PBFREEDB.dll has failed"
END IF
END FUNCTION
in Windows XP geht das aber einfacher man braucht nur pbfreedb mit regsvr32 auszuführen!
Habe das Project neu gepackt und oben dazu gefügt
nach dem erfolgreichen registrieren der dll muss im Com Browser folgende Zeile erscheinen
die Einbindung des Objects unter Excel oder Word bedarf es leider einer 32Bit Version von Excel oder Word In der 64 Bit Version geht es nicht! Beispiel und Beschreibung folgt! :)
Ist das Hauptprogramm in PowerBASIC geschrieben geht es auch mit Excel und Word 64!
Nächster Schritt für die Verwendung mit Excel. Das gilt für Office ab Version 2007! Bei früheren Versionen ist das nicht nötig!
Die Entwickler Tools müssen eingeschaltet werden.
(https://fbcdn-sphotos-d-a.akamaihd.net/hphotos-ak-prn2/t1/1897757_724939780873725_1753152029_n.jpg)
(https://fbcdn-sphotos-f-a.akamaihd.net/hphotos-ak-prn2/t1/1901274_724940617540308_38451307_n.jpg)
Das geht so wie oben im Bild beschrieben.
Also Excel Optionen einstellen!
Dabei Entwickler Tools aktivieren
Excel müßte dann so ausschauen das Tab mit Entwickler Tools siehe Bild unten müßte erscheinen.
(https://fbcdn-sphotos-h-a.akamaihd.net/hphotos-ak-prn2/t1/1601302_724975670870136_1619879324_n.jpg)
Als nächstes bitte die das Tab Entwickler Tools anwählen das erscheint das Button ,,Code Anzeigen" das müssen sie auswählen
(https://fbcdn-sphotos-b-a.akamaihd.net/hphotos-ak-ash4/t1/1656426_725356867498683_1524349734_n.jpg)
Es erscheint dann die VBA Umgebung von Excel. Bitte wählen sie hier den Menüpunkt ,,Extras" an!
(https://fbcdn-sphotos-a-a.akamaihd.net/hphotos-ak-frc3/t1/1506945_725365320831171_2107045352_n.jpg)
Hier dann den Menüpunkt Verweise auswählen.
(https://fbcdn-sphotos-g-a.akamaihd.net/hphotos-ak-ash3/t1/1904180_725397207494649_594901198_n.jpg)
Hier bitte den Verweis pbfreedb anwählen. Danach kann dann das VBA Programm geschrieben werden das das Objekt nutzt
(https://fbcdn-sphotos-f-a.akamaihd.net/hphotos-ak-prn2/t1/1780835_725400550827648_2059093858_n.jpg)
Hallo,
Wichtig ist dem Objekt die Objekt Variable zu übergeben! da diese intern für Funktionen benötigt wird
Public Sub freedbinit()
Set cfreedb = New FREEDB
initcfreedb cfreedb
App.Title = ThisWorkbook.Name
App.Major = "1"
App.Minor = "1"
combo3() = Split(cfreedb.GETCDROMS, "|")
cda = 1
For i = LBound(combo3) To UBound(combo3)
If cfreedb.GetMediaInfo(combo3(i)) <> "" Then
CdAudio = cda
Exit For
End If
cda = cda + 1
Next i
cfreedb.APPNAME = App.Title
cfreedb.APPVERSION = App.Major & "." & App.Minor
cfreedb.EMAILADDRESS = "peter.weis@freenet.de"
cfreedb.CDDBSERVER = "freedb.freedb.org"
cfreedb.CDDBINTERFACE = AUTO
cfreedb.CDDBMODE = SUBMIT '%TEST
cfreedb.USEFIRSTMATCH = True
cfreedb.ALLOWSUBMISSION = False
cfreedb.INTERNETENABLE = True
With UserForm1
.CommandButton1.Enabled = False
For i = 0 To UBound(combo3()) - 1
.ComboBox1.AddItem (combo3(i))
Next i
End With
End Sub
(https://fbcdn-sphotos-b-a.akamaihd.net/hphotos-ak-frc1/t31/1796056_730514223649614_1612521075_o.jpg)
Im Übrigen habe das Objekt an die neuen Versionen von Office angepasst da die nur noch mit Unicode Strings zurechtkommen. Das Objekt steht oben zum Download bereit
Hallo Freunde,
Hab festgestellt das es noch zwei Probleme bei der Anbindung an Excel gibt ein Problem ist, das Excel das Laufwerk nicht mehr frei gibt das einmal gescannt wurde! komischerweise hatte ich das Problem nicht mit älteren Versionen von Excel.
Das andere Problem ist das PowerBasic die Attribute bei der Parameterübergabe nicht in die Typelib schreibt was ich schon in der Version 9 von PowerBASIC moniert habe! So können keine Optionalen Parameter übergeben werden
Bin aber dran die Probleme zum Beseitigen!
Grüße Peter
Hallo,
sieht doch heute mal nicht schlecht aus bin weiter gekommen.
Wie man sieht liest das Objekt von CD und holt sich dann die dazugehörigen Titel aus dem Internet ;D
(https://fbcdn-sphotos-h-a.akamaihd.net/hphotos-ak-prn2/t31/1911221_733769763324060_1650576168_o.jpg)
Dafür müssen aber die Makros in Excel für die Tabelle aktiviert werden siehe hier
(https://scontent-a-cdg.xx.fbcdn.net/hphotos-ash3/t31/1960928_733771973323839_1800550852_o.jpg)
Im nächsten Schritt muss der Makro gestartet werden.
(https://fbcdn-sphotos-c-a.akamaihd.net/hphotos-ak-frc3/t31/1798985_733772406657129_2094579241_o.jpg)
Dann sollte dieser einfache Dialog erscheinen. Bei dem man das CD Laufwerk auswählt das Button sollte dann freigegeben werden! Und man kann sich die Daten aus dem Internet holen. Natürlich muss auch eine Audio CD im Laufwerk liegen
(https://fbcdn-sphotos-a-a.akamaihd.net/hphotos-ak-frc1/t31/1890542_733772769990426_1118713998_o.jpg)
Den Code hab ich natürlich wieder oben dazu gelegt!
Das Com Objekt beinhaltet auch noch mehrere Dialog. z.B die Serverauswahl oder wen mehrere Möglichkeiten auf dem Server liegen! Damit man darauf einen Zugriff hat muss man dem Objekt das Handle des aktuellen Fenster übergeben. das hat mir wirklich etwas Kopfzerbrechen bereitet. Da man in VBA eigentlich nicht mit Handles arbeitet. Habe aber eine Lösung gefunden! ;)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Sub CommandButton1_Click()
Call sethandle(whandle)
Call BUTTONQUERY
UserForm1.Hide
End Sub
Private Sub UserForm_Activate()
If Val(Application.Version) >= 9 Then
whandle = FindWindow("ThunderDFrame", Me.Caption)
Else
whandle = FindWindow("ThunderXFrame", Me.Caption)
End If
End Sub
(https://scontent-a-cdg.xx.fbcdn.net/hphotos-prn1/t31/1606476_734230849944618_1834445476_o.jpg)
Ergebnis wen mehrere Titel von einer CD auf Server Liegen. Habe wieder alles gepackt und am ersten Topic hinzugefügt
Grüße Peter
Hallo ,
Eigentlich wollte ich jetzt daran arbeiten wie man die Typelib verändern kann, so das man auch Optionale Parameter nutzen kann. Nach dem ich aber im Internet gelesen hab das das Vivian Zale in den nächsten Tagen was neues bringen möchte, weil sie ein neues Team hat warte ich da mal! Werde ich euch mal aufzeigen wie man nach verschiedenen Methoden mit dem Objekt suchen kann!
Einmal klar über freedb server
Zum zweiten über FREEDB Files die sich am Rechner befinden. Dafür muss die Datenbank hier herunter geholt werden http://www.freedb.org/en/download__database.10.html und entpackt werden
(https://scontent-a-cdg.xx.fbcdn.net/hphotos-ash3/t1/1911603_737138932987143_2070054267_n.jpg)
Zum dritten über DAO Datenbank. Die aber noch ein Problem hat weil die Datenbank über zwei Gig hat dieses Problem muss ich auch noch lösen. Mikrosoft Access lässt nämlich nur zwei Gig zu. Ich muss die Datenbank splitten.
(https://fbcdn-sphotos-b-a.akamaihd.net/hphotos-ak-ash3/t1.0-9/1959381_737136812987355_886434311_n.jpg)
Etwas verrückt aber es ist so :-[
VBA unterstützt bei Aufruf von Funktionen in DLL nur ANSI Strings, keine Unicode Strings. Bei Objekten ist das anders da werden nur Unicode Strings erwartet.
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function BrowseForDirectoryA Lib "pbfreedb" ( _
ByVal hwnd As Long, _
ByVal Title As String, _
Optional showFiles As Integer, _
Optional startDir As String) As String
habe die Funktionen BrowseForDirectoryA und BrowseForDirectoryW umgeschrieben und durch neuen Dialog Style ersetzt schaut moderner aus und ist hundert mal schneller ;D als der alte Dialog.
'*****************************************
'** Browse for Directory / Files Dialog **
'*****************************************
FUNCTION BrowseForDirectoryW ALIAS "BrowseForDirectoryW" (BYVAL hwnd AS LONG, BYVAL Title AS WSTRING, _
BYVAL uflags AS LONG, _
OPT startDir AS WSTRING) EXPORT AS WSTRING
DIM lpIDList AS LONG
DIM iNull AS INTEGER
DIM sPath AS WSTRINGZ * %MAX_PATH
DIM BrInfo AS BrowseInfoW
STATIC zstartDir AS WSTRINGZ * %MAX_PATH
BrInfo.hWndOwner = hwnd
BrInfo.lpszTitle = STRPTR(Title)
zstartdir = startDir
BrInfo.lparam = VARPTR(zstartdir)
BrInfo.ulFlags = uflags OR %BIF_NEWDIALOGSTYLE
BrInfo.pidlroot = 0
BrInfo.lpfnCallback = CODEPTR(BrowseCallbackProcW)
'set for call back...
'm_CurrentDirectoryW = startDir
'pop up dialog...
lpIDList = SHBrowseForFolderW(BrInfo)
IF (lpIDList) THEN
'sPath = Space$(260)
'convert id to path
IF SHGetPathFromIDListW(BYVAL lpIDList, sPath) THEN
BrowseForDirectoryW = sPath
END IF
'we must free the memory...
CALL CoTaskMemFree(lpIDList)
END IF
END FUNCTION
(https://fbcdn-sphotos-c-a.akamaihd.net/hphotos-ak-ash3/t31/1025580_738492909518412_97466562_o)
Hallo habe wieder ein paar Änderungen vorgenommen damit die Sache stabiler läuft
zum ersten habe ich die Objekte die das Interface ICollection benötigen nicht mehr Global definiert sondern sondern als Instanz definiert!
der Aufruf bei global war unter Excel nur einmal möglich!
INSTANCE colTrackNames AS ICollection
INSTANCE colTrackCDNames AS ICollection
INSTANCE colTrackTimes AS ICollection
INSTANCE colTrackNotes AS ICollection
INSTANCE colServers AS ICollection
dafür musste ich aber die Funktion DetectAudio in die Classe als CLASS Methode aufnehmen die vorher außerhalb war
Zum zweiten habe ich einen Timer eingefügt der während der Laufzeit überwacht ob das CD Laufwerk eine Audio-CD enthält!
Option Explicit
Public Declare Sub initcfreedb Lib "pbfreedb.dll" Alias "inintcfreedb" (par As PFREEDB)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowW" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetTimer Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal nIDEvent As Long) As Long
Private Declare Function GetDriveType Lib "kernel32.dll" _
Alias "GetDriveTypeA" ( _
ByVal nDrive As String) As Long
Const WM_TIMER = &H113 ' Timer-Ereignis trifft ein
Private hEvent As Long
Private TocTxT As String
Const MAX_PATH = 260
Const MATCH_NONE = 0
Const AUTO = 0
Const SUBMIT = 1
Const MCI = 3
Const SPI = 1
Const DRIVE_CDROM = 5
Private Type AppType
Title As String * 50
Major As String * 4
Minor As String * 4
Revision As String * 4
PATH As String * MAX_PATH
End Type
Public Type freedbconfig
dbfolter As String * MAX_PATH
drive As String * 20
InternetEnable As Integer
QueryLocalDatabase As Integer
End Type
Public dbfreec As freedbconfig
Dim App As AppType
Public cfreedb As FREEDB
Dim combo3() As String
' Timer-Prozedur, welche im Abstand der festgelegten
' Millisekunden ein Ereignis sendet
Public Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long)
'Dim ST As SYSTEMTIME
If uMsg = WM_TIMER Then
DisableTimer
initdrive
EnableTimer 200
' Lokale Zeit ermitteln...
' GetLocalTime ST
' ... und im Labelfeld der Form anzeigen
'Form1.Label1.Caption = Format$(ST.wHour, "00:") & _
' Format$(ST.wMinute, "00:") & Format$(ST.wSecond, "00 Uhr")
End If
End Sub
' Startet den Timer
Public Function EnableTimer(ByVal msInterval As Long)
If hEvent <> 0 Then Exit Function
hEvent = SetTimer(0&, 0&, msInterval, AddressOf TimerProc)
End Function
' Beendet den Timer
Public Function DisableTimer()
If hEvent = 0 Then Exit Function
KillTimer 0&, hEvent
hEvent = 0
End Function
Public Sub freedbinit()
If cfreedb Is Nothing Then
Set cfreedb = New FREEDB
initcfreedb cfreedb
End If
If cfreedb Is Nothing Then
MsgBox "Programm kann nicht gestartet werden weil FREEDB nicht geladen wurde"
Else
Open "mape1.cfg" For Binary As #1
Get #1, 1, dbfreec
Close #1
Dim cda, i, cdaudio As Integer
App.Title = ThisWorkbook.Name
App.Major = "1"
App.Minor = "1"
combo3() = Split(cfreedb.GetCdRoms, "|")
cda = 1
For i = LBound(combo3) To UBound(combo3)
If cfreedb.GetMediaInfo(combo3(i)) <> "" Then
cdaudio = cda
Exit For
End If
cda = cda + 1
Next i
EnableTimer 200
cfreedb.APPNAME = App.Title
cfreedb.APPVERSION = App.Major & "." & App.Minor
cfreedb.EMAILADDRESS = "peter.weis@freenet.de"
cfreedb.CDDBSERVER = "freedb.freedb.org"
cfreedb.CDDBINTERFACE = MCI
cfreedb.CDDBMODE = SUBMIT '%TEST
cfreedb.UseFirstMatch = False
cfreedb.ALLOWSUBMISSION = True
cfreedb.InternetEnable = dbfreec.InternetEnable
cfreedb.QueryLocalDatabase = dbfreec.QueryLocalDatabase
With UserForm1
.CommandButton1.Enabled = False
For i = 0 To UBound(combo3()) - 1
.ComboBox1.AddItem (combo3(i))
Next i
.OptionButton10.Value = dbfreec.InternetEnable
.OptionButton1.Value = dbfreec.QueryLocalDatabase
If Trim(dbfreec.drive) <> "" Then
.ComboBox1.Value = dbfreec.drive
End If
.TextBox1.Value = dbfreec.dbfolter
End With
End If
End Sub
Public Sub sethandle(ByVal handle As Long)
cfreedb.ParentHandle = handle
End Sub
Public Sub BUTTONQUERY()
Dim x As String
Dim ret As Long
x = cfreedb.pGetMediaTOC
If x <> "" Then
DisableTimer
If cfreedb.LookupMediaByToc(x) = MATCH_NONE Then
' cfreedb.LOOKUPMEDIADIRBYTOC ("")
End If
If cfreedb.MatchCodeNum <> MATCH_NONE Then
showInfo
End If
EnableTimer 200
End If
End Sub
Public Sub endprog()
Set cfreedb = Nothing
End
End Sub
Private Sub showInfo1()
Dim x, y As Integer
UserForm1.Hide
Sheets(1).Select
Cells.Select
Selection.Delete Shift:=xlUp
For x = 1 To 3
For y = 1 To cfreedb.GetAlbumTracks
Select Case x
Case 1
Cells(y, x).Value = cfreedb.SecondsToTimeString(cfreedb.GetTrackTime(y))
Case 2
Cells(y, x).Value = cfreedb.GetTrackName(y)
Case 3
Cells(y, x).Value = cfreedb.GetTrackNotes(y)
Case Else
End Select
Next y
Next x
Call endprog
End Sub
Public Sub initdrive()
Dim s As String
If GetDriveType(cfreedb.DriveLetter) = DRIVE_CDROM Then
s = cfreedb.GetMediaTOC(cfreedb.DriveLetter)
If s <> TocTxT Then
TocTxT = s
If TocTxT <> "" Then
cfreedb.LookupMediaDirByToc (TocTxT)
showInfo
Else
UserForm1.ListView1.ListItems.Clear
End If
End If
End If
End Sub
Private Sub showInfo()
Dim x, y As Integer
'UserForm1.Hide
'Sheets(1).Select
'Cells.Select
'Selection.Delete Shift:=xlUp
With UserForm1
.ListView1.ListItems.Clear
For x = 1 To 4
For y = 1 To cfreedb.GetAlbumTracks
Select Case x
Case 1
.ListView1.ListItems.Add , , Format(y, "##")
Case 2
.ListView1.ListItems(y).SubItems(1) = cfreedb.SecondsToTimeString(cfreedb.GetTrackTime(y))
Case 3
.ListView1.ListItems(y).SubItems(2) = cfreedb.GetTrackName(y)
Case 4
.ListView1.ListItems(y).SubItems(3) = cfreedb.GetTrackNotes(y)
Case Else
End Select
Next y
Next x
End With
End Sub
Bin aber noch nicht ganz zufrieden! Ihr hört von mir
(https://scontent-a-fra.xx.fbcdn.net/hphotos-prn2/t31.0-8/1655474_741653775868992_382219379_o.jpg)
Hallo,
kleine Ursache große Wirkung. Hatte bei der Übergabe des lokalen Ordner einen String fester Länge übergeben. Bei VBA Also MAX_PATH Zeichen, dieser wird von VBA in kompletter Länge übergeben. Die Methode QueryFlatFileSystem findet aber dann keine Übereinstimmungen mehr weil der Order auf der Festplatte nicht mehr gefunden wird!
Habe nun in Property CDDBFilePath ein Trim$ Funktion eingefügt damit diese Leerzeichen entfernt werden
PROPERTY SET CDDBFilePath ALIAS "CDDBFilePath"(BYVAL strPath AS WSTRING)
m_strCDDBFilePath = TRIM$(strPath)
END PROPERTY
Jetzt funktioniert auch die Suche mit VBA mit lokaler Datenbank auf Rechner :)
(https://fbcdn-sphotos-g-a.akamaihd.net/hphotos-ak-frc1/t31.0-8/1606441_743085692392467_165665276_o.jpg)
Hallo,
habe wieder mal ein bisserl was gemacht, habe das konvertieren in eine Access Datenbank umgeschrieben. Da das umwandeln mehrere Std dauert lasse ich das Ganze in einem THREAD im Hintergrund ablaufen, damit man mit dem während der Zeit auch weiter arbeiten kann.
THREAD FUNCTION CONVERT_MDB(BYVAL hdlg AS LONG) AS LONG
LOCAL lRslt AS LONG
LOCAL m_DBEngineidx, m_DBEngine AS Int_DBEngine
LOCAL m_dbWorkspaces, m_dbWorkspacesidx AS Workspaces
LOCAL m_dbWorkspace, m_dbWorkspaceidx AS Workspace
LOCAL dbDatabase, dbDatabaseidx AS Database
LOCAL dbRecordsetidx, dbRecordset AS Recordset
LOCAL dbTableDef AS Int_TableDef
LOCAL dbfields AS fields
LOCAL dbfield AS Int_Field
LOCAL dbTableDefs AS TableDefs
LOCAL DatabaseNr, i , dbupdate, Record AS LONG
LOCAL file, f AS WSTRING
STATIC dta AS DIRDATA
LOCAL sFlag AS INTEGER
DIM sFiles(0 TO 10) AS WSTRING
'init the catagory array...
sFiles(0) = "blues": sFiles(1) = "country": sFiles(2) = "classical"
sFiles(3) = "data": sFiles(4) = "folk": sFiles(5) = "jazz"
sFiles(6) = "misc": sFiles(7) = "newage": sFiles(8) = "reggae"
sFiles(9) = "rock": sFiles(10) = "soundtrack"
#IF %DEF($PROGID_DAO_DBEngine36)
m_DBEngineidx = ANYCOM $PROGID_DAO_DBEngine36
m_DBEngine = ANYCOM $PROGID_DAO_DBEngine36
#ELSE
m_DBEngineidx = ANYCOM $PROGID_DAO_DBEngine120
m_DBEngine = ANYCOM $PROGID_DAO_DBEngine120
#ENDIF
IF ISOBJECT(m_DBEngine) AND ISOBJECT (m_DBEngineidx) THEN
m_dbWorkspaces = m_DbEngine.Workspaces()
m_dbWorkspacesidx = m_DbEngineidx.Workspaces()
m_dbWorkspace = m_dbWorkspaces.Item(0)
m_dbWorkspaceidx = m_dbWorkspacesidx.Item(0)
END IF
IF ISOBJECT (cFREEDB) THEN
IF cfreedb.DAOUpdateMode = %False THEN
KILL cFREEDB.DAODir + "\" + "FREEDB*.MDB"
END IF
IF ISOBJECT(m_dbWorkspaceidx) AND ISOBJECT (m_dbWorkspace)THEN
dbDatabaseidx = m_dbWorkspaceidx.OpenDatabase(cFREEDB.DAODir + "\" + "FREEDBIDX.MDB", %False, %False)
IF ISFALSE ISOBJECT(dbDatabaseidx) THEN
ERRCLEAR
dbDatabaseidx = m_dbWorkspaceidx.CreateDatabase(cFREEDB.DAODir + "\" + "FREEDBIDX.MDB", $$dbLangGeneral)
END IF
dbrecordset = ObenDataBase(m_dbWorkspace, dbDatabase, DataBaseNr)
IF ((ISFALSE ISOBJECT(dbDatabaseidx)) OR (ISFALSE ISOBJECT(dbDatabase))) THEN
MSGBOX "Kann Datenbank FREEDB.MDB öffnen oder erstellen" & $CR & _
"Daten können dadurch nicht gespeichert werden", %MB_ICONERROR
FUNCTION = 0
EXIT FUNCTION
ELSE
dbrecordsetidx = dbDatabaseidx.OpenRecordset("FREEDBINDEX", %RecordsetTypeEnum.dbOpenDynaset, %RecordsetOptionEnum.dbDenyRead)
IF ISFALSE ISOBJECT(dbrecordsetidx) THEN
ERRCLEAR
dbTableDef = dbDatabase.CreateTableDef("FREEDBINDEX")
dbFields = dbTableDef.Fields
dbfield = dbTableDef.CreateField("DISKID", %DataTypeEnum.dbLong)
dbFields.Append dbfield
dbfield = dbTableDef.CreateField("DATNR", %DataTypeEnum.dbInteger)
dbFields.Append dbfield
dbfield = dbTableDef.CreateField("RECNR", %DataTypeEnum.dbLong)
dbFields.Append dbfield
dbTableDefs = dbdatabaseidx.tabledefs
dbTableDefs.Append (dbTabledef)
dbDatabaseidx.TableDefs.Refresh
dbRecordsetidx = dbTableDef.OpenRecordset(%RecordsetTypeEnum.dbOpenDynaset, %RecordsetOptionEnum.dbDenyRead)
dbField = NOTHING
dbFields = NOTHING
dbTableDef = NOTHING
dbTableDefs = NOTHING
END IF
DO
IF IsFreeDBFile (cFREEDB.CDDBFilePath, sFiles(i), File, DTA, sFlag) THEN
IF FilelenOpen(cFREEDB.DAODir + "\" + "FREEDB" + FORMAT$(DatabaseNr, "00")+ ".MDB" ) > 1000000000 THEN
INCR DatabaseNr
dbrecordset.Close
dbrecordset = NOTHING
dbDatabase.close
dbDatabase = NOTHING
dbrecordset = ObenDataBase(m_dbWorkspace, dbDatabase, DataBaseNr)
END IF
Record = 0
CALL dbsetrecord(file, sfiles(i), DatabaseNr, Record, dbDatabase, dbrecordset)
dbrecordsetidx.addnew
dbrecordsetidx.collect(0) = VAL("&H"+(File))
dbrecordsetidx.collect(1) = DataBaseNr
dbrecordsetidx.collect(2) = Record
'dbrecordset.collect(1) = PBReadFile(f)
dbrecordsetidx.update %UpdateTypeEnum.dbUpdateRegular
CONTROL SET TEXT hdlg, %IDC_LABEL8, "FreeDB File: " + File
'CONTROL SET TEXT CB.HNDL, %IDC_LABEL9, "MDB Recordset: " + sFiles(I)
IF dbupdate THEN
f = "Update Record Nr: " + FORMAT$(Record, "#########")
ELSE
f = "Copy Record Nr: "+ FORMAT$(Record, "#########")
END IF
CONTROL SET TEXT hdlg, %IDC_LABEL10, f
ELSE
INCR i
IF i > 10 THEN EXIT DO
END IF
LOOP
END IF
END IF
END IF
FUNCTION = lRslt
END FUNCTION
(https://fbcdn-sphotos-e-a.akamaihd.net/hphotos-ak-frc1/t31.0-8/1606521_489992544456775_8668184085897105235_o.jpg)
Zum zweiten habe ich ein paar Funktionen z. b. Filelen diese arbeitete mit Dir$ wen die Funktion in einen anderem Programm aufgerufen wurde arbeitete sie nicht mehr korrekt deswegen arbeite ich jetzt mit der Funktion FilelenOpen die jetzt die Windows API Funktion FindFirstFileW benutzt
FUNCTION FilelenOpen(BYVAL s AS WSTRING) AS DWORD
LOCAL FindFileData AS WIN32_FIND_DATAW
LOCAL hFind AS LONG
LOCAL temp AS WSTRING
LOCAL temp2 AS WSTRING
hFind = FindFirstFileW(BYVAL STRPTR(s), FindFileData)
IF BITSE(hFind, %INVALID_HANDLE_VALUE, 32) THEN
EXIT FUNCTION
ELSE
FindClose(hFind)
zsplitW s, temp, temp2
IF temp2 = FindFileData.cFileName THEN
FUNCTION = FindFileData.nFileSizeLow
END IF
END IF
END FUNCTION
Hab es überarbeitet für Windows 10
Hi hab festgestellt das PBFREE nicht mehr geht weil der Server FREEDB nicht mehr existiert >:(
ich bin aber am arbeiten daran um einen Ersatz zu finden wen jemand mir helfen kann mit dem einen anderen Server nutzen kann er mir gerne helfen
MFG Peter
Was gibt es da zu arbeiten?
Frag einfach ...
Für mich sind das nur wenige Klicks und ich weiss das.
QuoteDie FreeDB-Datenbank wurde ursprünglich von einem Community-Projekt betrieben, das die Metadaten von Audio-CDs sammelte und öffentlich zugänglich machte. Im Jahr 2020 gab das Projekt jedoch bekannt, dass es den Betrieb der FreeDB-Datenbank einstellen werde.
Seitdem haben sich verschiedene alternative CD-Datenbanken entwickelt, darunter MusicBrainz und Discogs. Diese Datenbanken haben ähnliche Ziele wie FreeDB, nämlich eine öffentlich zugängliche Sammlung von Metadaten für Audio-CDs bereitzustellen.
Es gibt verschiedene Möglichkeiten, auf die Datenbanken wie MusicBrainz oder Discogs zuzugreifen und ihre Metadaten abzufragen. Einige der gängigsten Methoden sind:
Verwendung von APIs: Diese Datenbanken bieten oft öffentliche APIs an, die es Entwicklern ermöglichen, auf ihre Daten zuzugreifen und Abfragen durchzuführen. Diese APIs verwenden normalerweise HTTP-Anfragen, um Daten zu übertragen, und geben die Ergebnisse im JSON- oder XML-Format zurück.
Verwendung von Bibliotheken: Es gibt verschiedene Bibliotheken und SDKs (Software Development Kits), die es einfacher machen, mit diesen Datenbanken zu interagieren. Diese Bibliotheken können in verschiedenen Programmiersprachen wie Python, Java oder C# verfügbar sein.
Verwendung von Datenbankabfragesprachen: Es ist auch möglich, Datenbankabfragesprachen wie SQL zu verwenden, um direkt auf die Datenbanken zuzugreifen und Abfragen auszuführen. Dies erfordert jedoch normalerweise spezielle Kenntnisse und Genehmigungen, um auf die Datenbanken zuzugreifen.
In jedem Fall ist es wichtig, die API-Dokumentation oder die Benutzerhandbücher der Datenbanken zu lesen, um zu verstehen, wie man auf ihre Daten zugreift und wie man Abfragen richtig formuliert.
... Musiktiteln, Künstlern und Alben zuzugreifen. Die API unterstützt eine Vielzahl von Abfragemöglichkeiten, einschließlich der Suche nach bestimmten Künstlern, Alben oder Tracks sowie der Abfrage von Metadaten basierend auf bestimmten Kriterien wie Erscheinungsjahr, Genre oder Land.
Die MusicBrainz API verwendet HTTP-Anfragen und gibt die Ergebnisse im JSON- oder XML-Format zurück. Die API unterstützt auch die Verwendung von Abfrageparametern, um die Abfrageergebnisse zu filtern oder zu sortieren.
Die vollständige Dokumentation der MusicBrainz API ist auf der offiziellen MusicBrainz-Website verfügbar. Dort findest du detaillierte Informationen zu den unterstützten Abfrageparametern und -optionen sowie Beispiele für die Verwendung der API in verschiedenen Programmiersprachen.
Ja, ich kann dir ein Beispiel für eine MusicBrainz-API-Abfrage geben.
Angenommen, du möchtest alle Alben von Queen abrufen. Die API-Abfrage würde folgendermaßen aussehen:
https://musicbrainz.org/ws/2/release?artist=0383dadf-2a4e-4d10-a46a-e9e041da8eb3&fmt=json
In dieser Abfrage wird die "release" Ressource angefordert, die alle veröffentlichten Alben darstellt. Der Parameter "artist" wird verwendet, um nach Alben des Künstlers mit der MusicBrainz-ID "0383dadf-2a4e-4d10-a46a-e9e041da8eb3" zu suchen. Dies ist die MusicBrainz-ID von Queen. Der Parameter "fmt" wird verwendet, um das Antwortformat auf JSON zu setzen.
Wenn du diese Abfrage in deinem Webbrowser eingibst, erhältst du eine JSON-Antwort mit allen Alben von Queen, die in der MusicBrainz-Datenbank erfasst sind. Diese Antwort enthält Informationen wie den Albumnamen, das Erscheinungsjahr, die Trackliste und die MusicBrainz-ID des Albums.
Dies ist nur ein einfaches Beispiel, und es gibt viele andere Möglichkeiten, die MusicBrainz-API zu nutzen, um detailliertere Abfragen durchzuführen oder andere Informationen wie Künstlerbiografien oder Songtexte abzurufen. Die genaue Abfrage hängt von deinen spezifischen Anforderungen ab.
Quote
Ja, es ist auch möglich, die MusicBrainz-API in C zu verwenden. Hier ist ein Beispielcode, der die Alben von Queen mit der MusicBrainz-ID "0383dadf-2a4e-4d10-a46a-e9e041da8eb3" abruft und die Albumtitel in der Konsole ausgibt:
#include <stdio.h>
#include <curl/curl.h>
#include <stdlib.h>
#include <string.h>
#include <jansson.h>
size_t callback(char *ptr, size_t size, size_t nmemb, void *userdata) {
// Diese Funktion wird vom CURL aufgerufen, um Daten von der API zu empfangen.
// Hier wird der empfangene Inhalt an den JSON-Parser übergeben.
size_t realsize = size * nmemb;
json_error_t error;
json_t *root = json_loads(ptr, 0, &error);
if (root) {
json_array_foreach(root, i, release) {
json_t *title = json_object_get(release, "title");
printf("%s\n", json_string_value(title));
}
json_decref(root);
}
return realsize;
}
int main() {
CURL *curl;
CURLcode res;
char *url = "https://musicbrainz.org/ws/2/release?artist=0383dadf-2a4e-4d10-a46a-e9e041da8eb3&fmt=json";
curl = curl_easy_init();
if (curl) {
curl_easy_setopt(curl, CURLOPT_URL, url);
curl_easy_setopt(curl, CURLOPT_WRITEFUNCTION, callback);
res = curl_easy_perform(curl);
curl_easy_cleanup(curl);
}
return 0;
}
In diesem Beispiel wird die CURL-Bibliothek verwendet, um die API-Anfrage an die MusicBrainz-Server zu senden und die empfangene Antwort zu verarbeiten. Die empfangenen Daten werden an die JSON-Bibliothek weitergegeben, die die Daten in ein JSON-Objekt parsen und durchlaufen wird, um die Albumtitel zu extrahieren und in der Konsole auszugeben.
Es ist wichtig zu beachten, dass du die MusicBrainz-API-Abfrage-URL an deine spezifischen Anforderungen anpassen musst, indem du die entsprechenden Parameter einfügst. Die genaue Syntax und die unterstützten Parameter findest du in der MusicBrainz-API-Dokumentation.
Quote
Ja, es ist auch möglich, die MusicBrainz-API in PowerBasic zu verwenden. Hier ist ein Beispielcode, der die Alben von Queen mit der MusicBrainz-ID "0383dadf-2a4e-4d10-a46a-e9e041da8eb3" abruft und die Albumtitel in der Konsole ausgibt:
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "WinHttpRequest.inc"
FUNCTION callback(BYREF data AS STRING, BYVAL size AS LONG, BYVAL userdata AS DWORD) AS LONG
LOCAL json AS VARIANT
LOCAL i AS LONG
' Daten als JSON-Objekt parsen
JSONPARSE(data, VARTYPE(json), json)
' Durch jedes Release im JSON-Objekt iterieren und den Titel ausgeben
FOR i = 0 TO JSONGETSIZE(json, "releases") - 1
PRINT JSONGETSTRING(json, "releases", i, "title")
NEXT i
JSONFREE(json)
FUNCTION = 0
END FUNCTION
FUNCTION PBMAIN() AS LONG
LOCAL HttpReq AS WinHttpRequest
LOCAL Url AS STRING
' MusicBrainz-API-Abfrage-URL mit Parametern
Url = "https://musicbrainz.org/ws/2/release?artist=0383dadf-2a4e-4d10-a46a-e9e041da8eb3&fmt=json"
' HTTP-Anfrage senden und Antwort empfangen
HttpReq.Initialize("PB MusicBrainz API")
HttpReq.Open("GET", Url)
HttpReq.SetRequestHeader("User-Agent", "PB MusicBrainz API")
HttpReq.Send("")
' Antwortinhalt an den Callback-Handler übergeben
HttpReq.WaitForResponse()
HttpReq.ResponseText(callback, 0)
FUNCTION = 0
END FUNCTION
In diesem Beispiel wird die WinHttpRequest-Bibliothek verwendet, um die API-Anfrage an die MusicBrainz-Server zu senden und die empfangene Antwort zu verarbeiten. Die empfangenen Daten werden an die JSON-Bibliothek weitergegeben, die die Daten in ein JSON-Objekt parsen und durchlaufen wird, um die Albumtitel zu extrahieren und in der Konsole auszugeben.
Es ist wichtig zu beachten, dass du die MusicBrainz-API-Abfrage-URL an deine spezifischen Anforderungen anpassen musst, indem du die entsprechenden Parameter einfügst. Die genaue Syntax und die unterstützten Parameter findest du in der MusicBrainz-API-Dokumentation.
Ja, hier ist eine Tabelle, die einige Vor- und Nachteile von MusicBrainz und Discogs vergleicht:
Das hier ist eine Tabelle, die kann ich hier aber nicht einfügen.
MusicBrainz Discogs
Daten Umfangreiche und präzise Metadaten für Musik Metadaten für Musik, aber auch für andere Medien
Community Große und engagierte Community von Freiwilligen Kommerzielle Community mit bezahlten Moderatoren
Lizenz CC0 (public domain) für Daten, aber nicht für Bilder Proprietäre Lizenz für Daten und Bilder
API Umfangreiche und dokumentierte RESTful API RESTful API mit begrenzten Funktionen
Dateneingabe Jeder kann Daten hinzufügen oder bearbeiten Nur verifizierte Benutzer können Daten hinzufügen oder bearbeiten
Datenqualität Variabel, da jeder Benutzer Daten hinzufügen oder bearbeiten kann Konsistenter, da Daten von verifizierten Benutzern kommen
Integration Mehrere Musik-Player und Anwendungen unterstützen MusicBrainz als Metadatenquelle
Weniger Unterstützung durch Drittanbieteranwendungen
Popularität Weniger bekannt als Discogs, aber mit stetig wachsendem Nutzerkreis
Beliebte Datenbank, aber auch mit begrenzten Metadaten für bestimmte GenresEs ist jedoch wichtig zu beachten, dass diese Vor- und Nachteile auf den individuellen Gebrauch und die Bedürfnisse des Benutzers ankommen. Einige Benutzer bevorzugen möglicherweise die Community und das Verifizierungssystem von Discogs, während andere sich auf die umfangreichen Metadaten und die öffentliche Domäne von MusicBrainz konzentrieren.
Quelle: ChatGPT (https://chat.openai.com/chat)