(17-08-18, 02:53 AM)elgokr كتب :

السلام عليكم ورحمة الله وبركاته

حتى يعم الفائدة تم انشاء هذا الموضوع

وهو طلب احد اعضاء المنتدى

الشرح مع الصورة لشكل البرنامج

يوجد موقع يقوم بجلب الغروب والشروق وظهور سطوع الشمس

وكذلك المد والجزر للبحر وطول اليوم والتوقيت لبداية ونهاية الفلكي

صورة توضيحية

السورس و برنامج الاختبار مرفق بالرد

الاكواد المستخدمة فى الفورم

كود :

Private Sub Form_Load()
Dim objHttp As Object, strURL As String, strText As String
Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")
strURL = "https://api.sunrise-sunset.org/json?lat=36.7201600&lng=-4.4203400&date=today"
objHttp.Open "GET", strURL, False
objHttp.setRequestHeader "User-Agent", _
"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHttp.Send ("")
strText = objHttp.responseText
Set objHttp = Nothing


Dim Text_ As String
Text_ = strText
Text_ = Replace(Text_, """", "")
Text_ = Replace(Text_, "{", "")
Text_ = Replace(Text_, "}", "")
Text_ = Replace(Text_, "results", "")
Text_ = Replace(Text_, "sunrise", "")
Text_ = Replace(Text_, "sunset", "")
Text_ = Replace(Text_, "solar_noon", "")
Text_ = Replace(Text_, "day_length", "")
Text_ = Replace(Text_, "status", "")
Text_ = Replace(Text_, "civil_twilight_begin", "")
Text_ = Replace(Text_, "civil_twilight_end", "")
Text_ = Replace(Text_, "nautical_twilight_begin", "")
Text_ = Replace(Text_, "nautical_twilight_end", "")
Text_ = Replace(Text_, "astronomical_twilight_begin", "")
Text_ = Replace(Text_, "astronomical_twilight_end", "")
Text_ = Replace(Text_, "::", "")
Text_ = Replace(Text_, ",:", ",")
Text_ = Replace(Text_, ",OK", "")


Dim FullTitle As String
FullTitle = "Sunrise:,Sunset:,Solar Noon:,Day Length:,Civil Twilight Begin:,Civil Twilight End:,Nautical Twilight Begin:,Nautical Twilight End:,Astronomical Twilight Begin:,Astronomical Twilight End:"
Dim Title() As String
Title = Split(FullTitle, ",")

Dim TextSpl() As String
TextSpl = Split(Text_, ",")


For ii = 0 To 9
   Text1.Text = Text1.Text + Title(ii) & " " & TextSpl(ii) & vbNewLine
Next

Text2(0).Text = TextSpl(0)  ' Sunrise
Text3(1).Text = TextSpl(1)  ' Sunset
Text4(2).Text = TextSpl(2)  ' Solar Noon
Text5(3).Text = TextSpl(3)  ' Day Length
Text6(4).Text = TextSpl(4)  ' Civil Twilight Begin
Text7(5).Text = TextSpl(5)  ' Civil Twilight End
Text8(6).Text = TextSpl(6)  ' Nautical Twilight Begin
Text9(7).Text = TextSpl(7)  ' Nautical Twilight End
Text10(8).Text = TextSpl(8) ' Astronomical Twilight Begin
Text11(9).Text = TextSpl(9) ' Astronomical Twilight End
End Sub

كل ما هو مطلوب فقط التعديل على الرابط

خاصة السطر 

PHP كود :

strURL = "https://api.sunrise-sunset.org/json?lat=36.7201600&lng=-4.4203400&date=today" 


هام للمستخدم عامة: يجب تغيير الطول والعرض لموقع البلد المطلوب جلب التوقيت الخاص بها

يمكنك استخدام اى موقع مثل خرائط جوجل وغيرها لجلب تلك البيانات

للتحكم اكثر فى الرابط حسب اليوم او يوم حسب التحديد يمكنك الاطلاع على الرابط التالى

موقع : sunrise sunset

الروابط يمكن استخدامها بطرق التالية :

PHP كود :

https://api.sunrise-sunset.org/json?lat=36.7201600&lng=-4.4203400
https://api.sunrise-sunset.org/json?lat=36.7201600&lng=-4.4203400&date=today
https://api.sunrise-sunset.org/json?lat=36.7201600&lng=-4.4203400&date=2018-06-28
https://api.sunrise-sunset.org/json?lat=36.7201600&lng=-4.4203400&formatted=0 


راجع الرابط بالاعلى لتوضح استخدام الروابط اكثر

اليكم التحميل من المرفقات

السورس (VB6)

تحياتى لكم

وتمنياتى للجميع التوفيق

(17-08-18, 05:40 AM)حسن الغزي كتب : شكرًا لك استاذنا لما قدمته من مجهود لخدمة هذا المنتدى الجميل

(17-08-18, 06:51 AM)Ahmed_Mansoor كتب : وعليكم السلام ورحمة الله وبركاته

ماشاء الله تبارك الله ، مبدع أخي دائماً الله يجزاك كل خير على ماتقدمه من إبداع ومساعده للإخوه الأعضاء إن شاء الله في ميزان حسناتك الله يزيدك من علمه وفضله .

- تحياتي لك .

(17-08-18, 02:28 PM)الاصيله كتب :

ماشاء الله عليك

ابدعت وتألقت شكرا لما بذلته من جهد خدمة للصالح العام

(17-08-18, 02:41 PM)حسن الغزي كتب : السلام عليكم
عند تشغيل البرنامج تظهر هذه الرساله ماهو السبب؟

(18-08-18, 01:44 AM)elgokr كتب :

المشكلة ليس لدى اى نسخة XP

كل ما يمكننى تجربة السورس على

Server  و 7 و 10

انظر لغداً اقوم بعمل جهاز وهمى بنسخة XP

واجرب مراجعة الكود عليه وهل انه سيحدث مشكلة فى الكود كما لديك ام لا

حاول خلال هذا ان تقوم بتجربة السورس على جهاز اخر اذا كان بنفس النسخة او اصدار اخر

تحياتى لك

(18-08-18, 02:28 AM)حسن الغزي كتب :

(18-08-18, 01:44 AM)elgokr كتب :

المشكلة ليس لدى اى نسخة XP

كل ما يمكننى تجربة السورس على

Server  و 7 و 10

انظر لغداً اقوم بعمل جهاز وهمى بنسخة XP

واجرب مراجعة الكود عليه وهل انه سيحدث مشكلة فى الكود كما لديك ام لا

حاول خلال هذا ان تقوم بتجربة السورس على جهاز اخر اذا كان بنفس النسخة او اصدار اخر

تحياتى لك

أشكرك من كل قلبي وآسف لأنني أتعبتك معي
ولكن ان شاء الله سيكون عملك في ميزان حسناتك