Çözüldü Ts dosyası süresi

[k0081]

Merhaba arkadaşlar;

Ts ( Transport Stream ) dosyasının süresini dosyayı açmadan command buton ile alabilirmiyiz ?

yardımıcı arkadaşa şimdiden Teşekkürler;

Dosya adı : 0001.ts
Dosya suresi : "35:43" gibi...

 

[halit3]

Buyurun bakalım kod

Dosya_adi = ThisWorkbook.Path & "\Kralın Kızı.TS"

#If Win64 Then
Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare PtrSafe Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
#Else
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
#End If


Sub zamanbul()
Dim yer As String
Dim lRet As Long
Dim sReturn As String
Dim Dosya_adi As String
Dim iMin As Integer
Dim iSec As Integer
Dim iSat As Integer
Dim i As Integer
'On Error Resume Next
Dosya_adi = ThisWorkbook.Path & "\Kralın Kızı.TS"
yer = Space$(255)
lRet = GetShortPathName(Dosya_adi, yer, Len(yer))
If lRet <> 0 Then
Dosya_adi = Left$(yer, InStr(yer, vbNullChar) - 1)
End If
mciSendString "open " & Dosya_adi & " type MPEGVideo alias mp3audio", 0, 0, 0
sReturn = Space$(256)
lRet = mciSendString("status mp3audio length", sReturn, Len(sReturn), 0&)
mciSendString "close mp3audio", 0, 0, 0
iSec = Int(Val(sReturn) / 1000)
iMin = Int(iSec / 60)
iSec = iSec - (iMin * 60)

If iMin > 59 Then
iSat = Int(iMin / 60)
iMin = iMin - (Int(iMin / 60) * 60)
End If
MsgBox Format$(iSat, "00") & ":" & Format$(iMin, "00") & ":" & Format$(iSec, "00")

End Sub

 

[k0081]

halit3

hocam kodu çalıştırdım, ama süreyi vermiyor.

 

[halit3]

Dosya_adi = ThisWorkbook.Path & "\Arka.TS"
Ekli resimde bendeki dosyada süreyi veriyor.

 

[Haluk]

Söz konusu dosyanızın konumu bilgisayarda, C:\TestFolder\0001.ts ise; alternatif olarak, aşağıdaki linkte verilen kodu kullanabilirsiniz....

Sayfaya yazdırılan sonuçlardan bir tanesi, sizin aradığınız olacaktır... Kodda, dosya adını kendinize göre uyarlayın (bigbuckbunny.mp4 yerine 0001.ts yazın)

https://www.excelforum.com/excel-programming-vba-macros/1264533-get-video-time-from-simple-url.html#post5066560

.

 

[k0081]

Halit3;

Hocam bilemiyorum... kodu çalıştırdım, sadece 0:0:0 olarak mesaj kutusunu verdi.

Acaba dosya biçimi-Formatı ile alakalı olabilirmi?

 

[k0081]

Söz konusu dosyanızın konumu bilgisayarda, C:\TestFolder\0001.ts ise; alternatif olarak, aşağıdaki linkte verilen kodu kullanabilirsiniz....

Sayfaya yazdırılan sonuçlardan bir tanesi, sizin aradığınız olacaktır... Kodda, dosya adını kendinize göre uyarlayın (bigbuckbunny.mp4 yerine 0001.ts yazın)

https://www.excelforum.com/excel-programming-vba-macros/1264533-get-video-time-from-simple-url.html#post5066560

.

Hocam kodu paylaşabilirmisiniz? özelden de gönderebilirsiniz.

 

[Haluk]

Kod zaten verdiğim linkte yazıyor .... neyi göndermemi istiyorsunuz anlamadım.

.

 

[k0081]

Kod zaten verdiğim linkte yazıyor .... neyi göndermemi istiyorsunuz anlamadım.

.

Hocam; Login veya register istiyor. Linki açtığımda benim ekranımda sadece bu yazı var.

 

[Haluk]

Linkteki kod budur;

Sub Test2()
    ' Haluk - 16/02/2019
    '
    Dim objShell As Object
    Dim objFolder As Object
    Dim objFolderItem As Object
    Dim strInfo As String
    
    Set objShell = CreateObject("shell.application")
    Set objFolder = objShell.Namespace("C:\TestFolder")
    
    If (Not objFolder Is Nothing) Then
        Set objFolderItem = objFolder.ParseName("bigbuckbunny.mp4")
    
        If (Not objFolderItem Is Nothing) Then
            For i = 0 To 40
            strInfo = objFolder.GetDetailsOf(objFolderItem, i)
            If Not strInfo = Empty Then
                iRow = iRow + 1
                Cells(iRow, 1) = objFolder.GetDetailsOf(objFolder.Items, i)
                Cells(iRow, 2) = strInfo
            End If
            Next
        End If
        
        Set objFolderItem = Nothing
    End If
    
    Set objFolder = Nothing
    Set objShell = Nothing
End Sub

 

[k0081]

Haluk;


Hocam kodu çalıştırdım. düzgün biçimde çalışıyor. Sayfaya yazdırılan değerlerde SÜRE yok. malesef.

*.avi dosyası üzerinde denedim, SÜRE yi veriyor.

 

[Haluk]

C:\TestFolder\bbb24p_00.ts dosyası için bendeki durum böyle;




.

 

[k0081]

C:\TestFolder\bbb24p_00.ts dosyası için bendeki durum böyle;


Ekli dosyayı görüntüle 204020

.

Başka dosya üzerinde deneyeyim..

Denedim...( *.ts ) Sonuç aynı süreyi vermiyor.. Bir de bana sadece SÜRE lazım. diğerleri şu an için gerekli değil.

süreyi bir değişkene alabilirsem, Yeterli olacaktır.

Teşekkür ediyorum.

 

[Haluk]

......
...
Bir de bana sadece SÜRE lazım. diğerleri şu an için gerekli değil.

süreyi bir değişkene alabilirsem, Yeterli olacaktır.

Bunu deneyin ... (muhtemelen bahsettiğiniz TS dosyasında bir sıkıntı var)

Sub Test3()
    ' Haluk - 12/03/2019
    ' E-Posta: sa4truss@gmail.com
    '
    Dim objShell As Object, objFolder As Object, objFolderItem As Object
    Dim strInfo As String, myMsg As String
    
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace("C:\TestFolder")
    Set objFolderItem = objFolder.ParseName("bbb24p_00.ts")
    
    If (Not objFolderItem Is Nothing) Then
        strInfo = objFolder.GetDetailsOf(objFolderItem, 27)
        myMsg = IIf(strInfo = Empty, "Veri bulunamadi!", strInfo)
        MsgBox myMsg
    End If
    
    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
End Sub

.

 

[k0081]

Haluk hocam; son göndermiş olduğunuz kodda hiç sonuç yok.

mesaj kutusu gelmedi.

 

[Haluk]

14 No'lu mesajda revize ettiğim kodu deneyin ... İlgili veri varsa sonucu verir, eğer yoksa ikaz mesajı verir.

.

 

[halit3]

Benim yazdığım 2 nolu mesajdaki kodu başka dosyalarınızda çalıştırıp denermisiniz mp3 ve mp4,avi dosyalarında
diğer taraftan aşağıdaki linklerde benzer konular önceden işlenmiş

https://excel.web.tr/threads/dosya-oezellik-bilgilerini-istenilen-dosyaya-yazdirmak.91761/
https://excel.web.tr/threads/klasoerde-bulunanlarin-tuem-adresini-yazma.92249/
https://excel.web.tr/threads/alt-klasorde-dosya-ozellikleri.105412/

 

[k0081]

Haluk;

Hocam denedim. Evet, avi dosyalarında sonuç Mesaj alıyorum... aynen istenen şekilde. Ama TS biçimlerinde hiçbir şekilde ileti yok. ya benim formatlarda bi sıkıntı var ( TS dosyalarında yani...) yada kod değişikliği gerekli..

Teşekkür ediyorum.

 

[k0081]

Halit3;

Hocam sizin göndermiş olduğunuz koddaki durum;

*.avi = 00:00:00
*.ts = 00:00:00
*.mp4 = 00:00:00
*.mp3 = 00:05:52

şeklinde ... sadece mp3 dosyasında SÜRE yi verdi. diğerlerinde Süreyi 00:00:00 olarak verdi...

Linkleri de inceledim, kodları denedim. avi ve mp3 lerde SÜRE tamamdır. Sorun yok. Ama TS lerde Süre ile alakalı hiçbir bilgi yok.. yani uzunlukta yok...

Teşekkür ediyorum.

 

[Haluk]

Aşağıdaki linkten, kullandığım TS dosyasını indirip kodu deneyin bence...

https://www.w6rz.net/bbb24p_00.zip

.