home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / RadioStrea2133471182008.psc / Form1.frm < prev    next >
Text File  |  2008-11-06  |  23KB  |  752 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
  3. Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "mswinsck.ocx"
  4. Begin VB.Form frmMain 
  5.    Caption         =   "Radiostreaming"
  6.    ClientHeight    =   4035
  7.    ClientLeft      =   60
  8.    ClientTop       =   375
  9.    ClientWidth     =   11370
  10.    Icon            =   "Form1.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   4035
  15.    ScaleWidth      =   11370
  16.    StartUpPosition =   1  'Fenstermitte
  17.    Begin VB.CheckBox chckShoutcast 
  18.       Caption         =   "Check1"
  19.       Height          =   255
  20.       Left            =   0
  21.       TabIndex        =   11
  22.       Top             =   3800
  23.       Width           =   200
  24.    End
  25.    Begin VB.CommandButton cmdAction 
  26.       Caption         =   "Eintrag entfernen"
  27.       BeginProperty Font 
  28.          Name            =   "Comic Sans MS"
  29.          Size            =   11.25
  30.          Charset         =   0
  31.          Weight          =   400
  32.          Underline       =   0   'False
  33.          Italic          =   0   'False
  34.          Strikethrough   =   0   'False
  35.       EndProperty
  36.       Height          =   255
  37.       Index           =   3
  38.       Left            =   7200
  39.       TabIndex        =   9
  40.       Top             =   3480
  41.       Width           =   2295
  42.    End
  43.    Begin VB.CommandButton cmdStations 
  44.       Caption         =   "&Radiostation zur Liste hinzufⁿgen"
  45.       BeginProperty Font 
  46.          Name            =   "Comic Sans MS"
  47.          Size            =   11.25
  48.          Charset         =   0
  49.          Weight          =   400
  50.          Underline       =   0   'False
  51.          Italic          =   0   'False
  52.          Strikethrough   =   0   'False
  53.       EndProperty
  54.       Height          =   255
  55.       Left            =   0
  56.       TabIndex        =   8
  57.       Top             =   9600
  58.       Width           =   3855
  59.    End
  60.    Begin VB.ListBox lstStationDetails 
  61.       BeginProperty Font 
  62.          Name            =   "Comic Sans MS"
  63.          Size            =   11.25
  64.          Charset         =   0
  65.          Weight          =   400
  66.          Underline       =   0   'False
  67.          Italic          =   0   'False
  68.          Strikethrough   =   0   'False
  69.       EndProperty
  70.       Height          =   1560
  71.       Left            =   0
  72.       TabIndex        =   7
  73.       Top             =   7920
  74.       Width           =   8415
  75.    End
  76.    Begin VB.CommandButton cmdAction 
  77.       Caption         =   "Stoppen &nach Track"
  78.       BeginProperty Font 
  79.          Name            =   "Comic Sans MS"
  80.          Size            =   11.25
  81.          Charset         =   0
  82.          Weight          =   400
  83.          Underline       =   0   'False
  84.          Italic          =   0   'False
  85.          Strikethrough   =   0   'False
  86.       EndProperty
  87.       Height          =   255
  88.       Index           =   2
  89.       Left            =   4800
  90.       TabIndex        =   6
  91.       Top             =   3480
  92.       Width           =   2295
  93.    End
  94.    Begin VB.CommandButton cmdAction 
  95.       Caption         =   "&Sofort stoppen"
  96.       BeginProperty Font 
  97.          Name            =   "Comic Sans MS"
  98.          Size            =   11.25
  99.          Charset         =   0
  100.          Weight          =   400
  101.          Underline       =   0   'False
  102.          Italic          =   0   'False
  103.          Strikethrough   =   0   'False
  104.       EndProperty
  105.       Height          =   255
  106.       Index           =   1
  107.       Left            =   2400
  108.       TabIndex        =   5
  109.       Top             =   3480
  110.       Width           =   2295
  111.    End
  112.    Begin VB.CommandButton cmdAction 
  113.       Caption         =   "&Aufnahme"
  114.       BeginProperty Font 
  115.          Name            =   "Comic Sans MS"
  116.          Size            =   11.25
  117.          Charset         =   0
  118.          Weight          =   400
  119.          Underline       =   0   'False
  120.          Italic          =   0   'False
  121.          Strikethrough   =   0   'False
  122.       EndProperty
  123.       Height          =   255
  124.       Index           =   0
  125.       Left            =   0
  126.       TabIndex        =   4
  127.       Top             =   3480
  128.       Width           =   2295
  129.    End
  130.    Begin MSComctlLib.ImageList ImageList1 
  131.       Left            =   7800
  132.       Top             =   4680
  133.       _ExtentX        =   1005
  134.       _ExtentY        =   1005
  135.       BackColor       =   -2147483643
  136.       ImageWidth      =   16
  137.       ImageHeight     =   16
  138.       MaskColor       =   12632256
  139.       _Version        =   393216
  140.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  141.          NumListImages   =   1
  142.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  143.             Picture         =   "Form1.frx":08CA
  144.             Key             =   ""
  145.          EndProperty
  146.       EndProperty
  147.    End
  148.    Begin MSWinsockLib.Winsock Winsock1 
  149.       Left            =   0
  150.       Top             =   5400
  151.       _ExtentX        =   741
  152.       _ExtentY        =   741
  153.       _Version        =   393216
  154.    End
  155.    Begin MSComctlLib.TreeView TreeView1 
  156.       Height          =   3855
  157.       Left            =   0
  158.       TabIndex        =   3
  159.       Top             =   4080
  160.       Width           =   8415
  161.       _ExtentX        =   14843
  162.       _ExtentY        =   6800
  163.       _Version        =   393217
  164.       Indentation     =   18
  165.       LabelEdit       =   1
  166.       LineStyle       =   1
  167.       Style           =   7
  168.       ImageList       =   "ImageList1"
  169.       Appearance      =   1
  170.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  171.          Name            =   "Comic Sans MS"
  172.          Size            =   11.25
  173.          Charset         =   0
  174.          Weight          =   400
  175.          Underline       =   0   'False
  176.          Italic          =   0   'False
  177.          Strikethrough   =   0   'False
  178.       EndProperty
  179.    End
  180.    Begin VB.PictureBox Picture1 
  181.       Appearance      =   0  '2D
  182.       AutoRedraw      =   -1  'True
  183.       BackColor       =   &H80000005&
  184.       BorderStyle     =   0  'Kein
  185.       ForeColor       =   &H80000008&
  186.       Height          =   255
  187.       Left            =   360
  188.       ScaleHeight     =   255
  189.       ScaleWidth      =   615
  190.       TabIndex        =   2
  191.       Top             =   3120
  192.       Visible         =   0   'False
  193.       Width           =   615
  194.    End
  195.    Begin VB.Timer Timer1 
  196.       Enabled         =   0   'False
  197.       Interval        =   100
  198.       Left            =   1800
  199.       Top             =   240
  200.    End
  201.    Begin MSComctlLib.ListView lvwStream 
  202.       Height          =   3255
  203.       Left            =   0
  204.       TabIndex        =   1
  205.       Top             =   120
  206.       Width           =   9255
  207.       _ExtentX        =   16325
  208.       _ExtentY        =   5741
  209.       View            =   3
  210.       LabelEdit       =   1
  211.       LabelWrap       =   -1  'True
  212.       HideSelection   =   0   'False
  213.       HideColumnHeaders=   -1  'True
  214.       FullRowSelect   =   -1  'True
  215.       GridLines       =   -1  'True
  216.       _Version        =   393217
  217.       ForeColor       =   -2147483640
  218.       BackColor       =   -2147483643
  219.       BorderStyle     =   1
  220.       Appearance      =   1
  221.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  222.          Name            =   "Comic Sans MS"
  223.          Size            =   11.25
  224.          Charset         =   0
  225.          Weight          =   400
  226.          Underline       =   0   'False
  227.          Italic          =   0   'False
  228.          Strikethrough   =   0   'False
  229.       EndProperty
  230.       NumItems        =   8
  231.       BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  232.          Object.Width           =   2540
  233.       EndProperty
  234.       BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  235.          SubItemIndex    =   1
  236.          Object.Width           =   2540
  237.       EndProperty
  238.       BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  239.          SubItemIndex    =   2
  240.          Object.Width           =   2540
  241.       EndProperty
  242.       BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  243.          SubItemIndex    =   3
  244.          Object.Width           =   2540
  245.       EndProperty
  246.       BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  247.          SubItemIndex    =   4
  248.          Object.Width           =   2540
  249.       EndProperty
  250.       BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  251.          SubItemIndex    =   5
  252.          Object.Width           =   2540
  253.       EndProperty
  254.       BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  255.          SubItemIndex    =   6
  256.          Object.Width           =   2540
  257.       EndProperty
  258.       BeginProperty ColumnHeader(8) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  259.          SubItemIndex    =   7
  260.          Object.Width           =   2540
  261.       EndProperty
  262.    End
  263.    Begin Projekt1.UserControl1 usrStreaming 
  264.       Height          =   510
  265.       Index           =   0
  266.       Left            =   0
  267.       TabIndex        =   0
  268.       Top             =   120
  269.       Width           =   510
  270.       _ExtentX        =   900
  271.       _ExtentY        =   900
  272.    End
  273.    Begin VB.Label lblInfo 
  274.       AutoSize        =   -1  'True
  275.       BackStyle       =   0  'Transparent
  276.       Caption         =   "Shoutcast-Radiostations"
  277.       Height          =   195
  278.       Left            =   240
  279.       TabIndex        =   10
  280.       Top             =   3840
  281.       Width           =   1725
  282.    End
  283. End
  284. Attribute VB_Name = "frmMain"
  285. Attribute VB_GlobalNameSpace = False
  286. Attribute VB_Creatable = False
  287. Attribute VB_PredeclaredId = True
  288. Attribute VB_Exposed = False
  289. Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, ByVal dwNameLen As Integer, ByVal dwReserved As Long) As Long
  290. Dim sConnType As String * 255
  291. Dim sWholeData As String
  292. Dim bDataReceived As Boolean
  293. Dim sEndTag As String
  294. Dim sShoutCastURL As String
  295.  
  296. Private Type Station
  297.     StationName As String
  298.     ID As String
  299.     BitRate As String
  300.     Genre As String
  301.     CurrentTrack As String
  302.     ListenerCount As String
  303. End Type
  304. Dim tStations(20000) As Station
  305. Dim sStationFileLoc As String
  306.  
  307. Private Sub chckShoutcast_Click()
  308. If chckShoutcast.Value = 0 Then
  309.     Me.Height = chckShoutcast.Top + chckShoutcast.Height + 10 + 420
  310. Else
  311.     Me.Height = cmdStations.Top + cmdStations.Height + 420
  312. End If
  313. End Sub
  314.  
  315. Private Sub cmdAction_Click(Index As Integer)
  316. With usrStreaming(lvwStream.SelectedItem.Index - 1)
  317. Select Case Index
  318.     Case 0
  319.         .StartRecording
  320.         cmdAction(Index).Enabled = False
  321.         cmdAction(1).Enabled = True
  322.         cmdAction(2).Enabled = True
  323.     Case 1
  324.         .StopRecording
  325.         cmdAction(Index).Enabled = False
  326.         cmdAction(2).Enabled = False
  327.         cmdAction(0).Enabled = True
  328.     Case 2
  329.         .StopAfterTrack = .StopAfterTrack Xor True
  330.     Case 3
  331.         .StopRecording
  332.         lvwStream.ListItems.Remove lvwStream.SelectedItem.Index
  333.         SaveStations
  334. End Select
  335. End With
  336. End Sub
  337.  
  338.  
  339.  
  340. Private Sub cmdStations_Click()
  341. Dim sFile As String
  342. Dim iPos As Long
  343. Dim iEndPos As Long
  344. If TreeView1.SelectedItem Is Nothing Then Exit Sub
  345. If tStations(TreeView1.SelectedItem.Index).ID = "" Then Exit Sub
  346. sShoutCastURL = "http://yp.shoutcast.com/sbin/tunein-station.pls?id=" & tStations(TreeView1.SelectedItem.Index).ID
  347. sEndTag = "Title1"
  348. Winsock1.Connect
  349. bDataReceived = False
  350. Do
  351. DoEvents
  352. Loop Until bDataReceived = True
  353. Winsock1.Close
  354. bDataReceived = False
  355. iPos = InStr(1, sWholeData, "File1=") + 6
  356. iEndPos = InStr(iPos, sWholeData, Chr$(10))
  357. sFile = Mid$(sWholeData, iPos, iEndPos - iPos)
  358. sFile = Replace$(sFile, "http://", "")
  359.  
  360. If lvwStream.FindItem(sFile) Is Nothing Then
  361.     AddStation sFile
  362. Else
  363.     lvwStream.FindItem(sFile).EnsureVisible
  364.     lvwStream.FindItem(sFile).Selected = True
  365. End If
  366.  
  367. End Sub
  368.  
  369. Private Sub Form_Load()
  370. Screen.MousePointer = 11
  371. WinAmpIsInstalled = IsWinampLocated
  372.  
  373.  
  374. PaintLVWBckground lvwStream
  375.  
  376.  
  377. sStationFileLoc = App.Path & IIf(Right$(App.Path, 1) = "\", "", "\") & "Stations.txt"
  378. ReadFile sStationFileLoc, lvwStream
  379.  
  380. FillTVWWithStations TreeView1
  381.  
  382. Timer1.Enabled = True
  383. Screen.MousePointer = 0
  384. End Sub
  385.  
  386. Private Sub Form_Resize()
  387. On Error Resume Next
  388. With lvwStream
  389.     .Width = Me.ScaleWidth - 2 * .Left
  390. '    .Height = Me.ScaleHeight - 2 * .Top
  391. End With
  392. lstStationDetails.Width = lvwStream.Width
  393. TreeView1.Width = lvwStream.Width
  394. End Sub
  395.  
  396. Private Sub Form_Unload(Cancel As Integer)
  397. Timer1.Enabled = False
  398. For i = 0 To usrStreaming.UBound
  399.     usrStreaming(i).StopRecording
  400. Next
  401. Unload Me
  402. End
  403. End Sub
  404.  
  405. Private Sub AddStation(sStation As String)
  406. Dim i As Integer
  407. Dim lv As ListItem
  408. Dim t As Long
  409. Dim f As Integer
  410. Set lv = lvwStream.ListItems.Add(, , sStation)
  411. Load usrStreaming(usrStreaming.UBound + 1)
  412. i = usrStreaming.UBound
  413. usrStreaming(i).Init sStation
  414. If InternetGetConnectedStateEx(Ret, sConnType, 254, 0) = 1 Then
  415.     usrStreaming(i).StartRecording
  416.     t = Timer
  417.     With usrStreaming(i)
  418.     While .IcyDataReceived = False And Timer - t < 2
  419.         DoEvents
  420.     Wend
  421.     If .ServerName = "" Then
  422.         lv.SubItems(1) = "Kein Streamempfang"
  423.         .StopRecording
  424.     Else
  425.         lv.SubItems(1) = .ServerName
  426.         lv.SubItems(5) = .Genre
  427.         lv.SubItems(6) = .URL
  428.         lv.SubItems(7) = .BitRate
  429.     End If
  430.     End With
  431. End If
  432.  
  433. f = FreeFile
  434. Open sStationFileLoc For Append As #f
  435. Print #f, sStation
  436. Close #f
  437.  
  438. End Sub
  439. Private Sub SaveStations()
  440. Dim f As Integer
  441. f = FreeFile
  442. Open sStationFileLoc For Output As #f
  443. For i = 1 To lvwStream.ListItems.Count
  444.     Print #f, lvwStream.ListItems(i)
  445. Next
  446. Close #f
  447. End Sub
  448. Private Sub ReadFile(sFile As String, lvw As ListView)
  449. Dim i As Integer
  450. Dim sInhalt As String
  451. Dim f As Integer
  452. Dim b() As String
  453. Dim lv As ListItem
  454. Dim t As Long
  455. f = FreeFile
  456.  
  457. On Error GoTo ErrorHandling
  458.  
  459. Open sFile For Binary As #f
  460. sInhalt = Space$(LOF(f))
  461. Get #f, , sInhalt
  462. Close #f
  463.  
  464. b = Split(sInhalt, vbCrLf)
  465.  
  466. For i = 0 To UBound(b)
  467.     If Trim$(b(i)) <> "" Then
  468.         Set lv = lvw.ListItems.Add(, , b(i))
  469.  
  470.  
  471.         If i > 0 Then Load usrStreaming(i)
  472.         usrStreaming(i).Init b(i)
  473.         
  474.         If InternetGetConnectedStateEx(Ret, sConnType, 254, 0) = 1 Then
  475.             usrStreaming(i).StartRecording
  476.             t = Timer
  477.             With usrStreaming(i)
  478.             While .IcyDataReceived = False And Timer - t < 2
  479.                 DoEvents
  480.             Wend
  481.             If .ServerName = "" Then
  482.                 lv.SubItems(1) = "Kein Streamempfang"
  483.                 .StopRecording
  484.             Else
  485.                 lv.SubItems(1) = .ServerName
  486.                 lv.SubItems(5) = .Genre
  487.                 lv.SubItems(6) = .URL
  488.                 lv.SubItems(7) = .BitRate
  489.             End If
  490.             End With
  491.         End If
  492.         
  493.  
  494.     End If
  495. Next
  496.  
  497. ErrorHandling:
  498.  
  499. End Sub
  500.  
  501.  
  502.  
  503. Private Sub lvwStream_Click()
  504. If lvwStream.SelectedItem Is Nothing Then Exit Sub
  505. With usrStreaming(lvwStream.SelectedItem.Index - 1)
  506.     If .CurrBytes = "" Then
  507.         cmdAction(0).Enabled = True
  508.         cmdAction(1).Enabled = False
  509.         cmdAction(2).Enabled = False
  510.     Else
  511.         cmdAction(0).Enabled = False
  512.         cmdAction(1).Enabled = True
  513.         cmdAction(2).Enabled = True
  514.     End If
  515. End With
  516.  
  517. End Sub
  518.  
  519. Private Sub Timer1_Timer()
  520. On Error Resume Next
  521. For i = 0 To usrStreaming.UBound
  522.     If lvwStream.ListItems(i + 1).SubItems(2) <> usrStreaming(i).StreamTitle Then
  523.         lvwStream.ListItems(i + 1).SubItems(2) = usrStreaming(i).StreamTitle
  524.     End If
  525.     
  526.     
  527.     If usrStreaming(i).CurrBytes = "" Then
  528.         If Not lvwStream.ListItems(i + 1).SubItems(3) = "No Recording" Then
  529.             lvwStream.ListItems(i + 1).SubItems(3) = "No Recording"
  530.         End If
  531.         lvwStream.ListItems(i + 1).SubItems(4) = ""
  532.     Else
  533.         lvwStream.ListItems(i + 1).SubItems(3) = usrStreaming(i).CurrBytes
  534.         lvwStream.ListItems(i + 1).SubItems(4) = usrStreaming(i).CurrTime
  535.     End If
  536.     DoEvents
  537. Next
  538. optimalWidth lvwStream
  539.  
  540. End Sub
  541. Private Sub PaintLVWBckground(lvw As ListView)
  542. With lvw
  543.     .ListItems.Add , , "Test"
  544.     With Picture1
  545.         .Height = 2 * lvw.ListItems(1).Height
  546.         Picture1.Line (0, 0)-(.Width, lvw.ListItems(1).Height), RGB(245, 245, 245), BF
  547.     End With
  548.     
  549.     Set .Picture = Picture1.Image
  550.     .PictureAlignment = lvwTile
  551.     .ListItems.Clear
  552. End With
  553. End Sub
  554.  
  555. Private Sub FillTVWWithStations(tvw As TreeView)
  556. Dim iPos As Long
  557. Dim i As Long
  558. Dim iEndPos As Long
  559. Dim tCount As Integer
  560. Dim p As Long
  561. Dim j As Long
  562. Dim sStation As String
  563. Dim sID As String
  564. Dim sGenre As String
  565. Dim sCurrTrack As String
  566. Dim sBitRate As String
  567. Winsock1.RemoteHost = "yp.shoutcast.com"
  568. Winsock1.RemotePort = 80
  569. sShoutCastURL = "http://yp.shoutcast.com/sbin/newxml.phtml?"
  570. sEndTag = "</genrelist>"
  571. Winsock1.Connect
  572. Do
  573. DoEvents
  574. Loop Until bDataReceived = True
  575. Winsock1.Close
  576. bDataReceived = False
  577. i = 1
  578. Do
  579.     j = InStr(i, sWholeData, "genre name", vbTextCompare)
  580.     If j > 0 Then
  581.         iPos = InStr(j, sWholeData, Chr$(34)) + 1
  582.         iEndPos = InStr(iPos, sWholeData, Chr$(34))
  583.         tvw.Nodes.Add , , "K" & Mid$(sWholeData, iPos, iEndPos - iPos), Mid$(sWholeData, iPos, iEndPos - iPos), 1
  584.         tvw.Nodes.Add tvw.Nodes.Count, tvwChild, , "..."
  585.         i = iEndPos
  586.     End If
  587. Loop Until j = 0
  588.  
  589. 'tCount = tvw.Nodes.Count
  590. '
  591. 'ReDim tStations(20000)
  592. '
  593. 'For p = 1 To tCount
  594. '    sWholeData = ""
  595. '    sShoutCastURL = "http://yp.shoutcast.com/sbin/newxml.phtml?genre=" & tvw.Nodes(p)
  596. '    sEndTag = "</stationlist>"
  597. '    Winsock1.Connect
  598. '    Do
  599. '    DoEvents
  600. '    Loop Until bDataReceived = True
  601. '    Winsock1.Close
  602. '    bDataReceived = False
  603. '    Do
  604. '        j = InStr(i, sWholeData, "station name", vbTextCompare)
  605. '        If j > 0 Then
  606. '            iPos = InStr(j, sWholeData, Chr$(34)) + 1
  607. '            iEndPos = InStr(iPos, sWholeData, Chr$(34))
  608. '            sStation = Mid$(sWholeData, iPos, iEndPos - iPos)
  609. '            iPos = InStr(iEndPos, sWholeData, "id=") + 4
  610. '            iEndPos = InStr(iPos, sWholeData, Chr$(34))
  611. '            sID = Mid$(sWholeData, iPos, iEndPos - iPos)
  612. '            iPos = InStr(iPos, sWholeData, "br=") + 4
  613. '            iEndPos = InStr(iPos, sWholeData, Chr$(34))
  614. '            sBitRate = Mid$(sWholeData, iPos, iEndPos - iPos)
  615. '            iPos = InStr(iPos, sWholeData, "genre=") + 7
  616. '            iEndPos = InStr(iPos, sWholeData, Chr$(34))
  617. '            sGenre = Mid$(sWholeData, iPos, iEndPos - iPos)
  618. '
  619. '            iPos = InStr(iPos, sWholeData, "ct=") + 4
  620. '            iEndPos = InStr(iPos, sWholeData, Chr$(34))
  621. '            sCurrTrack = Mid$(sWholeData, iPos, iEndPos - iPos)
  622. '
  623. '            With tStations(tvw.Nodes.Count + 1)
  624. '                .StationName = sStation
  625. '                .ID = sID
  626. '                .BitRate = sBitRate
  627. '                .Genre = sGenre
  628. '                .CurrentTrack = sCurrTrack
  629. '            End With
  630. '
  631. '
  632. '            tvw.Nodes.Add p, tvwChild, , sStation, 1
  633. '            i = iEndPos
  634. '        End If
  635. '    Loop Until j = 0
  636. '
  637. '
  638. '
  639. '    DoEvents
  640. 'Next
  641. 'ReDim Preserve tStations(tvw.Nodes.Count)
  642.  
  643. End Sub
  644.  
  645.  
  646.  
  647. Private Sub TreeView1_Click()
  648. With lstStationDetails
  649.     .Clear
  650.     If tStations(TreeView1.SelectedItem.Index).ID = "" Then Exit Sub
  651.     .AddItem "Station name: " & tStations(TreeView1.SelectedItem.Index).StationName
  652.     .AddItem "Genre: " & tStations(TreeView1.SelectedItem.Index).Genre
  653.     .AddItem "Bitrate: " & tStations(TreeView1.SelectedItem.Index).BitRate
  654.     .AddItem "Aktueller Titel: " & tStations(TreeView1.SelectedItem.Index).CurrentTrack
  655.     .AddItem "Momentane Zuh÷rerzahl: " & tStations(TreeView1.SelectedItem.Index).ListenerCount
  656. End With
  657. End Sub
  658.  
  659. Private Sub TreeView1_DblClick()
  660. 'MsgBox tStations(TreeView1.SelectedItem.Index).StationName & vbNewLine & tStations(TreeView1.SelectedItem.Index).CurrentTrack
  661.  
  662. End Sub
  663.  
  664. Private Sub TreeView1_Expand(ByVal Node As MSComctlLib.Node)
  665. Dim iPos As Long
  666. Dim i As Long
  667. Dim iEndPos As Long
  668. Dim tCount As Integer
  669. Dim p As Long
  670. Dim j As Long
  671. Dim sStation As String
  672. Dim sID As String
  673. Dim sGenre As String
  674. Dim sCurrTrack As String
  675. Dim sBitRate As String
  676. Dim sLC As String
  677. If Node.Child.Text = "..." Then
  678.     TreeView1.Enabled = False
  679.     Screen.MousePointer = 11
  680.     TreeView1.Nodes.Remove Node.Child.Index
  681.     sWholeData = ""
  682.     sShoutCastURL = "http://yp.shoutcast.com/sbin/newxml.phtml?genre=" & Node.Text
  683.     sEndTag = "</stationlist>"
  684.     Winsock1.Connect
  685.     Do
  686.     DoEvents
  687.     Loop Until bDataReceived = True
  688.     Winsock1.Close
  689.     bDataReceived = False
  690.     Do
  691.         j = InStr(i + 1, sWholeData, "station name", vbTextCompare)
  692.         If j > 0 Then
  693.             iPos = InStr(j, sWholeData, Chr$(34)) + 1
  694.             iEndPos = InStr(iPos, sWholeData, Chr$(34))
  695.             sStation = Mid$(sWholeData, iPos, iEndPos - iPos)
  696.             iPos = InStr(iEndPos, sWholeData, "id=") + 4
  697.             iEndPos = InStr(iPos, sWholeData, Chr$(34))
  698.             sID = Mid$(sWholeData, iPos, iEndPos - iPos)
  699.             iPos = InStr(iPos, sWholeData, "br=") + 4
  700.             iEndPos = InStr(iPos, sWholeData, Chr$(34))
  701.             sBitRate = Mid$(sWholeData, iPos, iEndPos - iPos)
  702.             iPos = InStr(iPos, sWholeData, "genre=") + 7
  703.             iEndPos = InStr(iPos, sWholeData, Chr$(34))
  704.             sGenre = Mid$(sWholeData, iPos, iEndPos - iPos)
  705.             iPos = InStr(iPos, sWholeData, "ct=") + 4
  706.             iEndPos = InStr(iPos, sWholeData, Chr$(34))
  707.             sCurrTrack = Mid$(sWholeData, iPos, iEndPos - iPos)
  708.             iPos = InStr(iPos, sWholeData, "lc=") + 4
  709.             iEndPos = InStr(iPos, sWholeData, Chr$(34))
  710.             sLC = Mid$(sWholeData, iPos, iEndPos - iPos)
  711.             
  712.             With tStations(TreeView1.Nodes.Count + 1)
  713.                 .StationName = sStation
  714.                 .ID = sID
  715.                 .BitRate = sBitRate
  716.                 .Genre = sGenre
  717.                 .CurrentTrack = sCurrTrack
  718.                 .ListenerCount = sLC
  719.             End With
  720.             
  721.             
  722.             TreeView1.Nodes.Add Node.Index, tvwChild, , sStation, 1
  723.             i = iEndPos
  724.         End If
  725.     Loop Until j = 0
  726.     Screen.MousePointer = 0
  727.     TreeView1.Enabled = True
  728. End If
  729. End Sub
  730.  
  731. Private Sub Winsock1_Connect()
  732.   Dim Cmd$, URL$
  733.      
  734.     URL = sShoutCastURL
  735.     Cmd = "GET " & URL & " HTTP/1.0" & vbCrLf & "Accept: */*" & _
  736.           vbCrLf & "Accept: text/html" & vbCrLf & vbCrLf
  737.           
  738.     Winsock1.SendData Cmd
  739.  
  740. End Sub
  741.  
  742. Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
  743. Dim sData As String
  744. Winsock1.GetData sData, vbString
  745. sWholeData = sWholeData & sData
  746. If InStr(1, sWholeData, sEndTag, vbTextCompare) Then
  747.     bDataReceived = True
  748.     Winsock1.Close
  749. End If
  750. End Sub
  751.  
  752.