Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
ShoutStore.bas
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 06.02.2014 01:35:15 |
'##############################################################################################################
If Command() <> "okidoki" Then
Print "---"
Print "ACHTUNG!"
Print ""
Print "Dieses Programm erzeugt eine Verzeichnisstruktur, erstellt Dateien und loescht diese teilweise auch wieder!"
Print "Aufgrund des experimentellen Stadiums dieses Source's kann es auch zu Datenverlust kommen!"
Print "Prüfen selbststaendig den quelltext um dir sicher zu sein, das du mit der Nutzung einverstanden bist!"
Print "Der Autor uebernimmt keine Schadenshaftung welche hierdurch entstehen!"
Print "Wenn du dies akzeptierst, dann starte das Programm in der Konsole mit dem Zusatz 'okidoki'"
Print "---"
End -1
End If
'##############################################################################################################
#Include Once "vbcompat.bi"
#Include Once "TSNE_V3.bi"
#If TSNE_VersionDate < 20120925
#Error Incompatible TSNE-Version!
#EndIf
'##############################################################################################################
Type File_Type
V_Time as Double
V_TimeStart as UInteger
V_TimeEnd as UInteger
V_File as String
V_StorState as UByte
V_Artist as String
V_Title as String
V_Album as String
V_CP as UByte
V_StorAlbum as UByte
End Type
Dim Shared G_FileD() as File_Type
Dim Shared G_FileC as UInteger
Dim Shared G_FileMux as Any Ptr
Dim Shared G_Thread as Any Ptr
Dim Shared G_ThreadExit as UByte
Dim Shared G_StatFN as Integer
'##############################################################################################################
Dim Shared G_Client as UInteger
Dim Shared G_Data as String
Dim Shared G_ICYFile as String
Dim Shared G_ICYHost as String
Dim Shared G_ICYPort as UShort
Dim Shared G_ICYInit as UByte
Dim Shared G_ICYMetaInt as UInteger
Dim Shared G_ICYMetaIntLen as UShort
Dim Shared G_ICYFileID as Integer
Dim Shared G_ICYFileX as UInteger
Dim Shared G_ICYName as String
'##############################################################################################################
Sub AddNewFile(V_Artist as String, V_Title as String, V_Album as String)
WindowTitle "ShoutStore - " & V_Artist & " - " & V_Title
MutexLock(G_FileMux)
If G_ICYFileID <> 0 Then Close #G_ICYFileID: G_ICYFileID = 0
With G_FileD(G_FileC)
If .V_StorState = 0 Then
If .V_File <> "" Then
Kill "temp/" & .V_File & ".mp3"
.V_File = ""
End If
End If
End With
For X as UInteger = G_FileC - 1 to 1 Step -1
G_FileD(X + 1) = G_FileD(X)
If G_FileD(X + 1).V_TimeEnd = 0 Then G_FileD(X + 1).V_TimeEnd = Timer()
Next
Dim TFile as File_Type
G_FileD(1) = TFile
With G_FileD(1)
G_ICYFileX += 1
.V_Time = Now()
.V_TimeStart = Timer()
.V_File = Format(Now(), "yyyymmdd_hhmmss")
.V_Artist = V_Artist
.V_Title = V_Title
.V_Album = V_Album
If .V_Artist = "" Then .V_Artist = "unknown"
If .V_Title = "" Then .V_Title = .V_File
If .V_Album = "" Then .V_Album = "unknown"
G_ICYFileID = FreeFile
If Open("temp/" & .V_File & ".mp3" For Binary as #G_ICYFileID) <> 0 Then G_ICYFileID = 0
End With
MutexUnLock(G_FileMux)
End Sub
'##############################################################################################################
Sub AddFileCheck(Nothing as Any Ptr)
Do
MutexLock(G_FileMux)
If G_ThreadExit = 1 Then MutexUnLock(G_FileMux): Exit Do
Dim TFNI as Integer
Dim TFNO as Integer
Dim T as String
Dim TLen as UInteger
Dim DD() as String
Dim DN() as UByte
Dim DS() as UByte
Dim DC as UInteger
Dim DX as UInteger
Dim DK as Ubyte
Dim RV as Integer
For X as UInteger = G_FileC - 1 to 1 Step -1
DK = 0
For DX = 1 to DC
If DD(DX) = G_FileD(X).V_Album Then
DN(DX) += 1
If G_FileD(X).V_StorState >= 1 Then DS(DX) += 1
DK = 1
Exit For
End If
Next
If DK = 0 Then
DC += 1
Redim preserve DD(DC) as String
Redim preserve DN(DC) as UByte
Redim preserve DS(DC) as UByte
DD(DC) = G_FileD(X).V_Album
DN(DC) = 1
If G_FileD(X).V_StorState >= 1 Then DS(DC) += 1
End If
Next
For X as UInteger = 2 to G_FileC
If G_FileC > 1 Then
With G_FileD(X)
For DX = 1 to DC
If DD(DX) = G_FileD(X).V_Album Then
If .V_StorState >= 1 Then
If (DN(DX) > 1) and (DS(DX) > 1) Then
If .V_StorAlbum = 0 Then .V_StorAlbum = 1
End If
End If
Exit For
End If
Next
If (.V_StorState = 1) or (.V_StorAlbum = 1) Then
If .V_StorAlbum = 1 Then .V_StorAlbum = 2
MKDir "files/"
If .V_StorAlbum = 0 Then
MKDir "files/" & .V_Artist & "/"
MKDir "files/" & .V_Artist & "/" & .V_Album & "/"
MKDir "files/" & .V_Artist & "/" & .V_Album & "/"
Else: MKDir "files/" & .V_Album & "/"
End If
TFNI = FreeFile
If Open("temp/" & .V_File & ".mp3" for Binary as #TFNI) = 0 Then
TFNO = FreeFile
If .V_StorAlbum = 0 Then
RV = Open("files/" & .V_Artist & "/" & .V_Album & "/" & .V_Title & ".mp3" for Binary as #TFNO)
Else: RV = Open("files/" & .V_Album & "/" & .V_Artist & "___" & .V_Title & ".mp3" for Binary as #TFNO)
End If
If RV = 0 Then
MutexUnLock(G_FileMux)
T = Space(&H0000FFFF)
TLen = LOF(TFNI)
For Y as UInteger = 1 to TLen Step &H0000FFFF
If Y + &H0000FFFF > TLen Then T = Space(TLen - Y + 1)
Get #TFNI, Y, T
Put #TFNO, Y, T
MutexLock(G_FileMux)
.V_CP = Fix(100 / TLen * Y)
MutexUnLock(G_FileMux)
Sleep 1, 1
Next
Close #TFNO
Close #TFNI
MutexLock(G_FileMux)
.V_CP = 100
.V_StorState = 2
Else: .V_StorState = 9: Close #TFNI
End If
Else: .V_StorState = 9
End If
End If
End With
End If
Next
MutexUnLock(G_FileMux)
Sleep 10, 1
Loop
End Sub
'##############################################################################################################
Sub TSNEInfo_Connected(ByVal V_TSNEID as UInteger)
Dim CRLF as String = Chr(13, 10)
Dim D as String
D += "GET /listen.pls HTTP/1.1" & CRLF
D += "Host: " & TSNE_GetHost(V_TSNEID) & ":" & Str(TSNE_GetPort(V_TSNEID)) & CRLF
D += "User-Agent: ShoutStore" & CRLF
D += "Range: bytes=0-" & CRLF
D += "Icy-MetaData: 1" & CRLF
D += "connection: close" & CRLF
D += CRLF
TSNE_Data_Send(V_TSNEID, D)
End Sub
'--------------------------------------------------------------------------------------------------------------
Sub TSNEInfo_NewData(ByVal V_TSNEID as UInteger, ByRef V_Data as String)
G_Data += V_Data
End Sub
'##############################################################################################################
Sub TSNECtl_Connected(ByVal V_TSNEID as UInteger)
Dim CRLF as String = Chr(13, 10)
Dim D as String
D += "GET / HTTP/1.1" & CRLF
D += "Host: " & TSNE_GetHost(V_TSNEID) & ":" & Str(TSNE_GetPort(V_TSNEID)) & CRLF
D += "User-Agent: ShoutStore" & CRLF
D += "Range: bytes=0-" & CRLF
D += "Icy-MetaData: 1" & CRLF
D += "connection: close" & CRLF
D += CRLF
TSNE_Data_Send(V_TSNEID, D)
End Sub
'--------------------------------------------------------------------------------------------------------------
Sub TSNECtl_NewData(ByVal V_TSNEID as UInteger, ByRef V_Data as String)
G_Data += V_Data
If Len(G_Data) > 100000 Then TSNE_Disconnect(V_TSNEID): Exit Sub
Dim XPos as UInteger
Dim XPos2 as UInteger
Dim XPos3 as UInteger
Dim T as String
Dim T1 as String
Dim T2 as String
Dim T3 as String
Dim T4 as String
Dim BC as Integer
Dim MX as UInteger
Dim TArtist as String
Dim TTitel as String
Dim TAlbum as String
If G_ICYInit = 1 Then
Do
If Len(G_Data) < G_ICYMetaInt + G_ICYMetaIntLen + 1 Then Exit Sub
G_ICYMetaIntLen = G_Data[G_ICYMetaInt] * 16
If Len(G_Data) < G_ICYMetaInt + G_ICYMetaIntLen + 1 Then Exit Sub
If G_ICYFileID <> 0 Then Print #G_ICYFileID, Left(G_Data, G_ICYMetaInt);
If G_ICYMetaIntLen > 0 Then
TArtist = ""
TTitel = ""
TAlbum = ""
T = Mid(G_Data, G_ICYMetaInt + 1, G_ICYMetaIntLen)
Print #G_StatFN, ">"; T; "<"
XPos = InStr(1, T, "StreamTitle='")
If XPos > 0 Then
T1 = Mid(T, XPos + 13)
XPos = InStr(1, T1, "'")
If XPos > 0 Then T = "StreamUrl='artist=" & Left(T1, XPos - 1) & "&title=" & Left(T1, XPos - 1) & "';"
T1 = ""
End If
Print #G_StatFN, ">"; T; "<"
XPos = InStr(1, T, ";StreamUrl='")
If XPos > 0 Then T = Mid(T, XPos + 1)
XPos = 0
XPos2 = 1
BC = 0
Do
XPos += 1
If XPos > Len(T) Then Exit Do
Select Case T[XPos - 1]
Case 39 ''
If BC = 0 Then BC = 1 Else BC = 0
Case 61 '=
If BC = 0 Then
T1 = Mid(T, XPos2, XPos - XPos2)
XPos2 = XPos + 1
End If
Case 59 ';
If BC = 0 Then
T2 = Mid(T, XPos2, XPos - XPos2)
XPos2 = XPos + 1
If LCase(T1) = "streamurl" Then
T1 = Mid(T2, 2, Len(T2) - 2) & "&"
Print #G_StatFN, ""
Print #G_StatFN, ">"; T1; "<"
Do
XPos3 = InStr(1, T1, "&")
If XPos3 = 0 Then Exit Do
T2 = Left(T1, XPos3 - 1)
T1 = Mid(T1, XPos3 + 1)
XPos3 = InStr(1, T2, "=")
If XPos3 > 0 Then
T3 = Mid(T2, XPos3 + 1)
T2 = Left(T2, XPos3 - 1)
Print #G_StatFN, ">"; T2; "<___>"; T3; "<"
XPos3 = 0
Do
XPos3 += 1
If XPos3 > Len(T3) Then Exit Do
If T3[XPos3 - 1] = 37 Then
If XPos3 <= (Len(T3) - 2) Then
Select Case UCase(Mid(T3, XPos3 + 1, 2))
Case "E4": T4 = "ae"
Case "C4": T4 = "Ae"
Case "F6": T4 = "oe"
Case "D6": T4 = "Oe"
Case "FC": T4 = "ue"
Case "": T4 = "Ue"
Case Else: T4 = Chr(CUByte("&H" & Mid(T3, XPos3 + 1, 2)))
End Select
T3 = Left(T3, XPos3 - 1) & T4 & Mid(T3, XPos3 + 3)
End If
End If
Loop
For XPos3 = 1 to Len(T3)
Select Case T3[XPos3 - 1]
Case 45, 48 to 57, 65 to 90, 95, 97 to 122
Case Else: T3[XPos3 - 1] = 95
End Select
Next
MX = 0
XPos3 = 0
Do
XPos3 += 1
If XPos3 > Len(T3) Then Exit Do
If T3[XPos3 - 1] = 45 Then
Select Case T3[XPos3]
Case 95, 32
MX += 1
If MX >= 2 Then T3 = Left(T3, XPos3 - 1): Exit Do
If MX > 1 Then
T3 = Left(T3, XPos3 - 1) & Mid(T3, XPos3 + 2)
Else: T3 = Left(T3, XPos3 - 1) & "__" & Mid(T3, XPos3 + 2)
End If
Case Else: T3 = Left(T3, XPos3) & Mid(T3, XPos3 + 1)
End Select
End If
Loop
For XPos3 = 1 to Len(T3)
Select Case T3[XPos3 - 1]
Case 48 to 57, 65 to 90, 95, 97 to 122
Case Else: T3[XPos3 - 1] = 95
End Select
Next
Do
If Asc(Left(T3, 1)) = 95 Then T3 = Mid(T3, 2) Else Exit Do
Loop
Do
If Asc(Right(T3, 1)) = 95 Then T3 = Left(T3, Len(T3) - 1) Else Exit Do
Loop
Select Case LCase(T2)
Case "artist" : TArtist = T3
Case "title" : TTitel = T3
Case "album" : TAlbum = T3
End Select
End If
Loop
End If
End If
End Select
Loop
If TArtist = TTitel Then
XPos = InStr(1, TArtist, "___")
If XPos > 0 Then
TTitel = Mid(TArtist, XPos + 3)
TArtist = Left(TArtist, XPos - 1)
End If
End If
Do
If Asc(Left(TArtist, 1)) = 95 Then TArtist = Mid(TArtist, 2) Else Exit Do
Loop
Do
If Asc(Right(TArtist, 1)) = 95 Then TArtist = Left(TArtist, Len(TArtist) - 1) Else Exit Do
Loop
Do
If Asc(Left(TTitel, 1)) = 95 Then TTitel = Mid(TTitel, 2) Else Exit Do
Loop
Do
If Asc(Right(TTitel, 1)) = 95 Then TTitel = Left(TTitel, Len(TTitel) - 1) Else Exit Do
Loop
TArtist = Trim(TArtist)
TTitel = Trim(TTitel)
TAlbum = Trim(TAlbum)
Print #G_StatFN, "NEW-FILE: >"; TArtist; "<___>"; TTitel; "<___>"; TAlbum; "<"
AddNewFile(TArtist, TTitel, TAlbum)
End If
G_Data = Mid(G_Data, G_ICYMetaInt + G_ICYMetaIntLen + 2)
Loop
End If
XPos = InStr(1, G_Data, Chr(13, 10, 13, 10))
If XPos <= 0 Then Exit Sub
T = Left(G_Data, XPos - 1)
G_Data = Mid(G_Data, XPos + 4)
Do
XPos = InStr(1, T, Chr(13, 10))
If XPos = 0 Then Exit Do
T1 = Left(T, XPos - 1)
T = Mid(T, XPos + 2)
XPos = InStr(1, T1, ":")
If XPos > 0 Then
Select Case LCase(Left(T1, XPos - 1))
Case "icy-notice1"
Case "icy-notice2"
Case "icy-name" : G_ICYName = Trim(Mid(T1, XPos + 1))
Case "icy-genre"
Case "icy-url"
Case "icy-pub"
Case "icy-metaint" : G_ICYMetaInt = CUInt(Trim(Mid(T1, XPos + 1)))
Case "icy-br"
End Select
End If
Loop
G_ICYInit = 1
End Sub
'##############################################################################################################
Sub DoConnect()
Dim RV as Integer
Print "[Connecting]"
'Dubstep.fm = http://72.13.91.147:80
RV = TSNE_Create_Client(G_Client, "72.13.91.147", 80, 0, @TSNEInfo_Connected, @TSNEInfo_NewData, 60)
If RV <> TSNE_Const_NoError Then Print "[FEHLER] " & TSNE_GetGURUCode(RV): End -1
TSNE_WaitClose(G_Client)
Dim XPos as Integer = InStr(1, G_Data, Chr(13, 10, 13, 10))
If XPos <= 0 Then Print "http error1": end -1
G_Data = Mid(G_Data, XPos + 4)
XPos = InStr(1, G_Data, "File1=")
If XPos <= 0 Then Print "icy error1": end -1
G_Data = Mid(G_Data, XPos + 6)
XPos = InStr(1, G_Data, Chr(10))
If XPos <= 0 Then Print "icy error2": end -1
G_Data = Left(G_Data, XPos - 1)
Print "FILE:"; G_Data
XPos = InStr(1, G_Data, "://")
If XPos <= 0 Then Print "icy error3": end -1
G_ICYHost = Mid(G_Data, XPos + 3)
XPos = InStr(1, G_ICYHost, "/")
If XPos <= 0 Then Print "icy error4": end -1
G_ICYFile = Mid(G_ICYHost, XPos)
G_ICYHost = Left(G_ICYHost, XPos - 1)
XPos = InStr(1, G_ICYHost, ":")
If XPos > 0 Then
G_ICYPort = CUShort(Mid(G_ICYHost, XPos + 1))
G_ICYHost = Left(G_ICYHost, XPos - 1)
Else: G_ICYPort = 80
End If
G_Data = ""
RV = TSNE_Create_Client(G_Client, G_ICYHost, G_ICYPort, 0, @TSNECtl_Connected, @TSNECtl_NewData, 60)
If RV <> TSNE_Const_NoError Then Print "[FEHLER] " & TSNE_GetGURUCode(RV): Sleep 1000, 1
End Sub
'##############################################################################################################
Dim TWidth as UInteger = 900
G_StatFN = freefile
Open Cons for output as #G_StatFN
G_FileMux = MutexCreate()
G_FileC = 14
Redim preserve G_FileD(G_FileC) as File_Type
ScreenRes TWidth, (G_FileC + 1) * 20, 32
WindowTitle "ShoutStore @ThePuppetMaster"
Print "clear temp..."
MKDir "temp/"
MKDir "files/"
Dim N as String
Dim DD() as String
Dim DC as UInteger
N = Dir("temp/*", -1)
Do Until N = ""
If (N <> ".") and (N <> "..") Then
If (Len(N) = 19) and (Mid(N, 9, 1) = "_") and (Right(N, 4) = ".mp3") Then
For X as UInteger = 1 to Len(N) - 4
Select Case N[X - 1]
Case 48 to 57
Case 95: If X <> 9 Then N = "": Exit For
Case Else: N = ""
End Select
Next
Else: N = ""
End If
If N <> "" Then
DC += 1
Redim Preserve DD(DC) as String
DD(DC) = N
End If
End If
N = Dir("", -1)
Loop
For X as UInteger = 1 to DC
Kill "temp/" & DD(X)
Next
DoConnect()
Dim CB as UInteger
Dim CF as UInteger
Dim TMR as Integer
Dim TMX as Integer
Dim TMY as Integer
Dim TMB as Integer
Dim TMBL as Integer
Dim TID as UByte
Dim TCL as UInteger
G_Thread = ThreadCreate(@AddFileCheck)
Do Until InKey() = Chr(27)
TMR = GetMouse(TMX, TMY, , TMB)
If (TMB <> TMBL) Then
If (TMB = 1) or (TMB = 2) Then
TID = Fix(TMY / 20)
If (TID >= 1) and (TID <= G_FileC) Then
With G_FileD(TID)
If .V_File <> "" Then
If TMB = 1 Then
If .V_StorState = 0 Then .V_StorState = 1
Else: If .V_StorState = 1 Then .V_StorState = 0
End If
End If
End With
End If
End If
End If
TMBL = TMB
MutexLock(G_FileMux)
ScreenLock()
CLS()
For X as UInteger = 1 to G_FileC
With G_FileD(X)
If .V_File <> "" Then
Select Case .V_StorState
Case 0: CB = &H00AAAAFF: CF = &H00000000
Case 1: CB = &H00FFFFAA: CF = &H00000000
Case 2: CB = &H00AAFFAA: CF = &H00000000
Case 9: CB = &H00FF0000: CF = &H00000000
End Select
Line (0, X * 20)-(TWidth, (X + 1) * 20), CB, BF
If (.V_CP > 0) and (.V_CP < 100) Then Line (0, X * 20)-(TWidth / 100 * .V_CP, (X + 1) * 20), &H0000FF00, BF
Line (0, X * 20)-(TWidth, (X + 1) * 20), &H00000000, B
If X = 1 Then
TCL = Timer() - .V_TimeStart
Else: TCL = .V_TimeEnd - .V_TimeStart
End If
N = Format(Fix(TCL / 3600), "00") & ":"
TCL mod= 3600
N += Format(Fix(TCL / 60), "00") & ":"
TCL mod= 60
N += Format(TCL, "00")
If X = 1 Then
Draw String (5, 7 + X * 20), "> " & Format(.V_Time, "hh:mm:ss") & " [" & N & "] " & .V_Artist & Space(25 - IIf(Len(.V_Artist) > 25, 25, Len(.V_Artist))) & " - " & .V_Title & Space(35 - IIf(Len(.V_Title) > 35, 35, Len(.V_Title))) & " - " & .V_Album, CF
Else: Draw String (5, 7 + X * 20), " " & Format(.V_Time, "hh:mm:ss") & " [" & N & "] " & .V_Artist & Space(25 - IIf(Len(.V_Artist) > 25, 25, Len(.V_Artist))) & " - " & .V_Title & Space(35 - IIf(Len(.V_Title) > 35, 35, Len(.V_Title))) & " - " & .V_Album, CF
End If
End If
End With
Next
Draw String (8, 7), Format(Now(), "yyyy.mm.dd - mmmm - dddd - hh:mm:ss") & " | " & G_ICYName, &H006666BB
ScreenUnLock()
MutexUnLock(G_FileMux)
If TSNE_IsClosed(G_Client) = 1 Then
DoConnect()
End If
Sleep 10, 1
Loop
MutexLock(G_FileMux)
G_ThreadExit = 1
MutexUnLock(G_FileMux)
ThreadWait(G_Thread)
End 0