aliyk bunu yazdı programın kendisini vereydinde uğraşmıyaydık buyur http://www.tahribat.com/Forum-Td-Online-Muzik-Oynatici-156765/ Kaynak kod verdiğin iyi olmuş eline sağlık. C# a çevirip kullanabilirm ileride.

aliyk bunu yazdı programın kendisini vereydinde uğraşmıyaydık buyur http://www.tahribat.com/Forum-Td-Online-Muzik-Oynatici-156765/ saol bakıyorum http://profil.gittigidiyor.com/kady

programın kendisini vereydinde uğraşmıyaydık buyur http://www.tahribat.com/Forum-Td-Online-Muzik-Oynatici-156765/

programın kendisini vereydinde uğraşmıyaydık Lekum Dinikum Veliye Din...

Dim ArananSey, YeniSarkiZamani, i Dim nID As NOTIFYICONDATA Private Declare Function ShellExecute Lib "shell32. dll" Alias "ShellExecuteA" As Long Private Sub CandyButton1_Click If Check1. Value = "1" Then 'karşık şarkı Randomize random = Int + 0 id. Text = random durum. Caption = names. List & " açılıyor" WebBrowser1. Navigate links. List YeniSarkiZamani = Minute + Combo1. Text If YeniSarkiZamani > 59 Then YeniSarkiZamani = YeniSarkiZamani - 59 End If Else id. Text = id. Text + 1 durum. Caption = names. List & " açılıyor" WebBrowser1. Navigate links. List YeniSarkiZamani = Minute + Combo1. Text If YeniSarkiZamani > 59 Then YeniSarkiZamani = YeniSarkiZamani - 59 End If End If End Sub Private Sub Check2_Click If Check2. Value = False Or durum. Caption = "TD Software" Then xpFrame2. Visible = False Form1. Width = "5940" Else xpFrame2. Visible = True Form1. Width = "11745" End If End Sub Private Sub Command1_Click names. Clear links. Clear ArananSey = Replace(Text3. Text, " ", "+") Inet1. Execute "http://m. youtube.com/results?gl=US&hl=en&client=mv-google&search_type=videos&search_sort=relevance&uploaded=&q=" & ArananSey & "&p=" & pageid. Text, "GET", , "User-Agent: Mozilla/5.0 (Windows; U; Windows NT 6.1; tr; rv:1.9.2.12) Gecko/20101026 Firefox/3.6.15 " & vbCrLf & " Content-Type: application/x-www-form-urlencoded" Timer1. Enabled = True End Sub Function TagYakala On Error Resume Next On Local Error Resume Next arrs = Split arrB = Split(arrs(1), tags) TagYakala = arrB(0) End Function Private Sub Command2_Click linklertext. SetFocus End Sub Private Sub durum_Click If durum. Caption = "TD Software" Then Shell "explorer. exe http://tdsoftware.tr. cx" Else URL = Replace$(WebBrowser1. LocationURL, "embed/", "watch?v=") URL = Replace$(URL, "?autoplay=1", "") ShellExecute 0, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus 'Shell "explorer. exe " & WebBrowser1. LocationURL End If End Sub Private Sub Form_Click minimize_to_tray End Sub Private Sub Form_Load For i2 = 1 To 9 Combo1. AddItem i2 Next i2 End Sub Private Sub Inet1_StateChanged Dim vtData As Variant Dim strData As String Dim bDone As Boolean Dim arr As String Dim i As Integer Select Case State Case icError vtData = Inet1. ResponseCode & " - " & Inet1. ResponseInfo Case icResponseCompleted ' 12 bDone = False vtData = Inet1. GetChunk(1024, icString) DoEvents Do While Not bDone strData = strData & vtData vtData = Inet1. GetChunk(1024, icString) DoEvents If Len = 0 Then bDone = True End If Loop Me. kaynak. Text = Replace If InStr(1, Me. kaynak. Text, "Lookup Results") > 0 Then MsgBox "yes, query success" End If Text2. Text = Inet1. Object End Select End Sub Private Sub linklertext_GotFocus linklertext. SelStart = 0 linklertext. SelLength = Len - 1 End Sub Private Sub tahribat_Click Shell "explorer http://tahribat.com" End Sub Private Sub names_Click For i = 0 To names. ListCount - 1 If names. Selected Then id. Text = i durum. Caption = names. List & " açılıyor" WebBrowser1. Navigate links. List YeniSarkiZamani = Minute + Combo1. Text If YeniSarkiZamani > 59 Then YeniSarkiZamani = YeniSarkiZamani - 59 End If End If Next i End Sub Private Sub tdomp_Timer If names. ListCount > 0 Then CandyButton1. Enabled = True Text4. Enabled = True Check2. Enabled = True If YeniSarkiZamani = Minute Then If Check1. Value = "1" Then 'karşık şarkı Randomize random = Int + 0 id. Text = random durum. Caption = names. List & " açılıyor" WebBrowser1. Navigate links. List YeniSarkiZamani = Minute + Combo1. Text If YeniSarkiZamani > 59 Then YeniSarkiZamani = YeniSarkiZamani - 59 End If Else id. Text = id. Text + 1 durum. Caption = names. List & " açılıyor" WebBrowser1. Navigate links. List YeniSarkiZamani = Minute + Combo1. Text If YeniSarkiZamani > 59 Then YeniSarkiZamani = YeniSarkiZamani - 59 End If End If End If Else CandyButton1. Enabled = False Text4. Enabled = False Check2. Enabled = False End If End Sub Private Sub Text4_Change SearchInListBox names, Text4. Text, False End Sub Private Sub Timer1_Timer On Error Resume Next If pageid. Text = toplamsayfa. Text Then Timer1. Enabled = False Else If Text2. Text = "http://m. youtube.com/results?gl=US&hl=en&client=mv-google&search_type=videos&search_sort=relevance&uploaded=&q=" & ArananSey & "&p=" & pageid. Text Then ' If okeymi. Text = "0" Then For link = 1 To 9 linkler = TagYakala(kaynak, tag1. Text & link & tag2. Text, tag3. Text) isimi = TagYakala(kaynak, tag2. Text & linkler & tag3. Text, tag7. Text) If linkler <> "" Then List1. AddItem linkler temizlendi = Replace$ temizlendi = Replace$ linklertext. Text = linklertext. Text + "http://youtube.com/" & temizlendi & vbCrLf links. AddItem "http://www.youtube.com/embed" & temizlendi & "?autoplay=1" & vbCrLf isimi = Right$(isimi, Len - 2) isimi = Replace$ isimi = Replace$ isimi = Replace$ isimi = Replace$ isimi = Replace$ isimi = Replace$ isimi = Replace$ isimi = Replace$ isimi = Replace$ isimi = Replace$ isimi = Replace$ isimi = Replace$ isimi = Replace$ isimi = Replace$ isimi = Replace$ isimi = Replace$ isimi = Replace$ isimi = LCase names. AddItem isimi End If Next link pageid. Text = pageid. Text + 1 Inet1. Execute "http://m. youtube.com/results?gl=US&hl=en&client=mv-google&search_type=videos&search_sort=relevance&uploaded=&q=" & ArananSey & "&p=" & pageid. Text, "GET", , "User-Agent: Mozilla/5.0 (Windows; U; Windows NT 6.1; tr; rv:1.9.2.12) Gecko/20101026 Firefox/3.6.15 " & vbCrLf & " Content-Type: application/x-www-form-urlencoded" Do While Inet1. StillExecuting DoEvents Loop link = 1 Label4. Caption = "Sonuçlar " End If Else End If End If End Sub Private Sub WebBrowser1_CommandStateChange durum. Caption = WebBrowser1. LocationName If durum. Caption = "http:///" Then durum. Caption = "TD Software" End If End Sub Private Sub WebBrowser1_StatusTextChange durum. Caption = WebBrowser1. LocationName If durum. Caption = "http:///" Then durum. Caption = "TD Software" End If End Sub Private Sub Form_MouseMove On Error Resume Next Dim Msg As Long Dim sFilter As String Msg = X / Screen. TwipsPerPixelX Select Case Msg Case WM_LBUTTONDOWN Me. Show Shell_NotifyIcon NIM_DELETE, nID Case WM_LBUTTONUP Case WM_LBUTTONDBLCLK Case WM_RBUTTONDOWN Case WM_RBUTTONUP Me. Show Shell_NotifyIcon NIM_DELETE, nID Case WM_RBUTTONDBLCLK End Select End Sub Private Sub Form_Unload On Error Resume Next Shell_NotifyIcon NIM_DELETE, nID ' del tray icon End Sub Sub minimize_to_tray On Error Resume Next Me. Hide nID. cbSize = Len nID. hWnd = Me. hWnd nID. uId = vbNull nID. uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE nID. uCallBackMessage = WM_MOUSEMOVE nID. hIcon = Me. Icon ' the icon will be your Form1 project icon nID. szTip = "TD Online Müzik Oynatıcı" & vbNullChar Shell_NotifyIcon NIM_ADD, nID End Sub Private Sub xpFrame1_Click minimize_to_tray End Sub Public Type NOTIFYICONDATA cbSize As Long hWnd As Long uId As Long uFlags As Long uCallBackMessage As Long hIcon As Long szTip As String 64 End Type Public Const NIM_ADD = &H0 Public Const NIM_MODIFY = &H1 Public Const NIM_DELETE = &H2 Public Const WM_MOUSEMOVE = &H200 Public Const NIF_MESSAGE = &H1 Public Const NIF_ICON = &H2 Public Const NIF_TIP = &H4 Public Const WM_LBUTTONDBLCLK = &H203 'Double-click Public Const WM_LBUTTONDOWN = &H201 'Button down Public Const WM_LBUTTONUP = &H202 'Button up Public Const WM_RBUTTONDBLCLK = &H206 'Double-click Public Const WM_RBUTTONDOWN = &H204 'Button down Public Const WM_RBUTTONUP = &H205 'Button up Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" As Boolean Private Declare Function SetWindowPos Lib "user32" As Long Const SWP_NOMOVE As Long = &H2 Const SWP_NOSIZE As Long = &H1 Const HWND_TOPMOST = -1 Const HWND_NOTOPMOST = -2 Option Explicit Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ As Long Private Const CB_FINDSTRINGEXACT = &H158 Private Const CB_FINDSTRING = &H14C Private Const LB_FINDSTRINGEXACT = &H1A2 Private Const LB_FINDSTRING = &H18F Public Declare Function GetTickCount Lib "kernel32" As Long Public Declare Function GetAsyncKeyState Lib "user32" As Integer Public Sub wait Dim dblStart As Double Dim dblEnd As Double Dim dblTickCount As Double dblTickCount = GetTickCount dblStart = GetTickCount dblEnd = GetTickCount + dblMilliseconds Do DoEvents dblTickCount = GetTickCount Loop Until dblTickCount > dblEnd Or dblTickCount < dblStart End Sub Public Function SearchInComboBox As Long Dim strTemp As String Dim lngReturn As Long If intKeyCode >= 65 And intKeyCode <= 90 Then With cboObject strTemp = . Text If bMatch Then lngReturn = SendMessage(. hWnd, CB_FINDSTRINGEXACT, -1, ByVal strTemp) Else lngReturn = SendMessage(. hWnd, CB_FINDSTRING, -1, ByVal strTemp) End If If lngReturn <> -1 Then. ListIndex = lngReturn. SelStart = Len . SelLength = Len - Len Else. Text = strTemp. SelStart = Len End If End With End If End Function Public Function SearchInListBox As Long Dim lngReturn As Long With lstObject If bMatch Then lngReturn = SendMessage(. hWnd, LB_FINDSTRINGEXACT, -1, ByVal strTemp) Else lngReturn = SendMessage(. hWnd, LB_FINDSTRING, -1, ByVal strTemp) End If. ListIndex = lngReturn End With End Function