السلام عليكم
ارجاء من الاخوان التعديل على هذا الكود لان هذا الكود لا يعمل على ويندز 7 ولا عرف ما المشكلة
عندا تركيب الكود على فجوال بيسك الجديد لا يعمل يقول يوجد اخطاء لا عرف اين الاخطاء
------------------------------------------------------
Private Sub Command3_Click()
cSysTray1.InTray = True
End Sub
Private Sub Command1_Click()
On Error Resume Next
Command1.Enabled = False
Dim strhtml As String
strhtml = Inet1.OpenURL("http://wwwxxxxxxxate.txt")
Label1.Caption = strhtml
Delay 5
s = Mid(Label1.Caption, 1, 3)
If s = "yes" Then
Label1.Caption = Mid(Label1.Caption, 5, Len(Label1.Caption) - 3)
s = MsgBox("يوجد تحديث جديد للبرنامج , هل توافق على تثبيته؟", vbYesNo, "تحديث")
If s = 7 Then
Command1.Enabled = True
Exit Sub
Else
'==============تنزيل ملفات التحديث
Dim gf As String
gf = Replace(GetFilename(Label1.Caption), vbNewLine, "")
Dim Mx() As Byte
Mx() = Inet1.OpenURL(Label1.Caption, 1)
Kill "C:\WINDOWSxxxxxx\" & gf
Open "C:\WINDOWS\xxxxx\" & gf For Binary Access Write As #1
Put #1, , Mx()
Close #1
MsgBox "تم التحديث بنجاح", vbInformation, "تم التحديث"
'===============================================
End If
Else
MsgBox "لا يوجد تحديث جديد للبرنامج", vbInformation, "تحديث"
End If
Command1.Enabled = True
End Sub
Public Function GetFilename(strURL As String) As String
Dim i As Integer
i = InStrRev(strURL, "/")
GetFilename = Mid(strURL, i + 1)
End Function
Public Sub Delay(HowLong As Date)
TempTime = DateAdd("s", HowLong, Now)
While TempTime > Now
DoEvents
Wend
End Sub
ارجاء من الاخوان التعديل على هذا الكود لان هذا الكود لا يعمل على ويندز 7 ولا عرف ما المشكلة
عندا تركيب الكود على فجوال بيسك الجديد لا يعمل يقول يوجد اخطاء لا عرف اين الاخطاء
------------------------------------------------------
Private Sub Command3_Click()
cSysTray1.InTray = True
End Sub
Private Sub Command1_Click()
On Error Resume Next
Command1.Enabled = False
Dim strhtml As String
strhtml = Inet1.OpenURL("http://wwwxxxxxxxate.txt")
Label1.Caption = strhtml
Delay 5
s = Mid(Label1.Caption, 1, 3)
If s = "yes" Then
Label1.Caption = Mid(Label1.Caption, 5, Len(Label1.Caption) - 3)
s = MsgBox("يوجد تحديث جديد للبرنامج , هل توافق على تثبيته؟", vbYesNo, "تحديث")
If s = 7 Then
Command1.Enabled = True
Exit Sub
Else
'==============تنزيل ملفات التحديث
Dim gf As String
gf = Replace(GetFilename(Label1.Caption), vbNewLine, "")
Dim Mx() As Byte
Mx() = Inet1.OpenURL(Label1.Caption, 1)
Kill "C:\WINDOWSxxxxxx\" & gf
Open "C:\WINDOWS\xxxxx\" & gf For Binary Access Write As #1
Put #1, , Mx()
Close #1
MsgBox "تم التحديث بنجاح", vbInformation, "تم التحديث"
'===============================================
End If
Else
MsgBox "لا يوجد تحديث جديد للبرنامج", vbInformation, "تحديث"
End If
Command1.Enabled = True
End Sub
Public Function GetFilename(strURL As String) As String
Dim i As Integer
i = InStrRev(strURL, "/")
GetFilename = Mid(strURL, i + 1)
End Function
Public Sub Delay(HowLong As Date)
TempTime = DateAdd("s", HowLong, Now)
While TempTime > Now
DoEvents
Wend
End Sub