Tarih Kontrol / Time API

[kumandur]

Merhabalar bir excel çalışma kitabının belli bir tarihten sonra içindeki makroların çalışmadan kapanmasını istiyorum buraya kadar sorun yok ama , sistem saaitni kullanmayacağım belki sistem saati değiştirilebilir diye ( int. bağlantısını kesip , tarih ayarlayarak ) sizin bu benzeri işlevler için kullandığınız Time API var mı ? limitsiz ve bedava olarak.


Teşekkür ederim.

 

[veyselemre]

Sub tarihSaatAl()

    Dim resp As String, x As Variant, tar As Date, y As Variant
    Dim url As String
    url = "https://timeapi.io/api/timezone/zone?timeZone=Europe%2FIstanbul" & "&_=" & Timer
    
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url, False
        .send
        resp = .responseText
        x = InStr(resp, "currentLocalTime")
        
        If x > 0 Then
            resp = Mid(resp, x + 19)
            x = InStr(resp, ",")
            resp = Left(resp, x - 2)
            x = Split(resp, "T")
            y = Split(x(0), "-")
            tar = DateSerial(y(0), y(1), y(2))
            y = Split(x(1), ".")
            tar = tar + TimeValue(y(0))
            MsgBox tar
        End If
    End With

End Sub

 

[kumandur]

Merhaba cevabınız için teşekkürler , timeapi.io yi kullandım , worldtime.org api sini kullanıyordum ama ne olduysa cevap vermiyor timeapi.io şimdilik bedava umarım bedava kalır. farklı kullandığınız emin olan var mı diye sormak istemiştim, kod içinde kullandım yoksa.

Yine ilginiz ve cevabınız için teşekkürler.

 

[Biolightant]

Merhaba,
Zaman Api lerinden bağımsız olarak şöyle bir Kurgu tasarladım

Test edecek arkadaşlar Kurguda açık kapıyı rastlarlarsa lütfen bildiriniz.

Kayıt Defterine (Regedit) 2 adet anahtar eklesek
1. program ilk çalıştığı zaman ( FirstTime ) anahtarı
2. programın bir önce ki çalıştığı zaman ( PreviousTime )
ve
Programın Çalışacağı zamanı belirlesek hedefTarih

1. aşama
program açılışta FirstTime varmı bakılır
FirstTime yoksa
FirstTime ve PreviousTime oluşturulur

2. aşama
FirstTime a zamanBirimi ve izinli sayısı eklenerek hedefTarih belirlenir

3. aşama
Şimdi=Programın çalıştırıldığı an = Now
Şimdi >(büyük) hedefTarih ise kullanım süresi doldu dosyayı kapat

4. aşama
Şimdi <(küçük) PreviousTime ise zaman geriye gitmez dosyayı kapat

5. aşama
her şey normal PreviousTime güncelle Şimdi yap

Benim gördüğüm Kurguda ki AÇIK lar
1. Zamanı Programı ilk kullandığı zamana geri getirirse Program çalışır
( ama tam dakikası dakikasına olmalı ve her çalıştırmadan önce bunu yapmalı )
2. Regeditten Anahtarlar silinebilir
3. VBA şifre kırılıp kodlar silinebilir
( 2. ve 3. seçenegi yapacak kişinin amacı programı bedava kullanmak değilde
sanki amacı kodları öğrenmek olacaktır diye düşünüyorum bırakalım öğrensin. )
.......
sizin ekleyeceğiniz AÇIKLARI iletirseniz sevinirim.

Not:
Test Kolay olsun diye
zamanBirimi "n" Dakika yaptım
izinli = 1 olarak kısa tuttum
yani yapılan dosya 1 Dakika kullanılabilir.

Kodlar, BuÇalışmaKitabı (ThisWorkbook) bölümüne yazılacak.

Option Explicit

Private Sub Workbook_Open()
'Biolight 2025 - Eppur Si Muove
' [ Regedit de ExcelMyProgram arayınız (ExcelMyProgram - Zaman içinde)]

    Dim hedefTarih As Date
    Dim zamanBirimi As String
    Dim izinli As Long
   
    ' İzinli zaman sınırını belirleyin
    zamanBirimi = "n" ' n=Dakika, h=Saat, d=Gün, m=Ay
    izinli = 1
   
    ' Program ilk defa çalıştırılmışsa zamanı kaydet
    If GetSetting("ExcelMyProgram", "Zaman", "FirstTime") = "" Then
        SaveSetting "ExcelMyProgram", "Zaman", "FirstTime", Now
        SaveSetting "ExcelMyProgram", "Zaman", "PreviousTime", Now
    End If

    ' İlk çalışma zamanı üzerine zamanBirimi kadar izinli eklenmiş Tarih
    hedefTarih = DateAdd(zamanBirimi, izinli, GetSetting("ExcelMyProgram", "Zaman", "FirstTime"))

    If Now > hedefTarih Then
        MsgBox "Malesef Kullanım süresi [" & izinli & "] Bitti.", vbInformation
        ' ThisWorkbook.Close
    ElseIf Now < GetSetting("ExcelMyProgram", "Zaman", "PreviousTime") Then
        ' Tarih geriye alınmış kitabı kapat
        ' ThisWorkbook.Close
        MsgBox "ZAMAN GERİYE ALINDI"
    Else
        ' herşey normal program çalışma zamanını kaydet
        SaveSetting "ExcelMyProgram", "Zaman", "PreviousTime", Now
    End If
End Sub

Eğer istenirse Ek Kodlar ( Anahtarı silmek ve Regedit anahtarlarla ilgili açıklama )

Sub AnahtarSIL()

On Error Resume Next
    DeleteSetting "ExcelMyProgram", "Zaman"
On Error GoTo 0

' '''''' Programın ilk çalışmaya başladığı Zaman (FirstTime) ''''''
' FirstTime Kaydet
'SaveSetting "ExcelMyProgram", "Zaman", "FirstTime", Now
' FirstTime Kontrol et
'GetSetting("ExcelMyProgram", "Zaman", "FirstTime")

'''''''''''''''''''''''''''''''''''''''''''''
' '''''' Programın bir önceki çalışma Zamanı (PreviousTime) ''''''
' PreviousTime Kaydet
'SaveSetting "ExcelMyProgram", "Zaman", "PreviousTime", Now
' PreviousTime Kontrol et
'GetSetting("ExcelMyProgram", "Zaman", "PreviousTime")

'''''''''''''''''''''''''''''''''''''''''''''
' kayıt defterinden anahtarı silmek için
'DeleteSetting "ExcelMyProgram", "Zaman"

End Sub

 

[Biolightant]

Örnek Dosya ProgramZamanKontrol.xlsm

Site Harici Link :

https://drive.google.com/uc?id=1DukAGQsR2reHkIQclwjXW-vz0069-Hlj

@excel.web.tr AI
!!! Site Dahili Link ve Resimler !!!

https://www.excel.web.tr/attachments/programzamankontrol-xlsm.255696/?hash=debf5ec827fe0e48c536f2b2dcdb46cf