Счётчик загрузок программ

Счётчик загрузок программ Сайт Алексея Муртазина (Star Cat) E-mail: starcat @ nm.ru

Счётчик загрузок программ    Давайте напишем программу, которая будет подсчитывать количество загрузок вашей основной программы и заодно повысить посещаемость сайта.
   1) Сперва скачайте файл Hotlog и заведите счётчик.В отличии от других счётчиков он не отключается. Установите параметр Я НЕ хочу участвовать в рейтинге.
   2) Создайте новый стандартный проект. Нажмите Ctrl+T, выберите объект Microsoft Internet Controls. Установите его на форму. Name = WebSchet - он будет загружать страницу со счётчиком. Ещё раз установите этот объект на форму - он будет загружать страницу вашего сайта. Занимая поверхность всей формы, скрывает первый объект. Вставьте код:

Const face="Times New Roman" strURL As String = "http://starcat-rus.narod.ru/"
Const face="Times New Roman" strTitle As String = "Программы Алексея Муртазина"
Dim Reg As Long

Const face="Times New Roman" strURLSchet As String = "Адрес страницы со счётчиком"
Const face="Times New Roman" strTitleSchet As String = "Счётчик"
Dim RegSchet As Long

Private Sub Form_Load()
    WebSchet.Navigate strURLSchet
    WebBrowser1.Navigate strURL
End Sub

Private Sub Form_Resize()
    WebBrowser1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

Private Sub Form_Unload(Cancel As Integer)
    End
End Sub

 'Начало загрузки сайта
Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
    If Reg < 2 Then
        If URL <> strURL Then End
    End If
End Sub

Private Sub WebBrowser1_StatusTextChange(ByVal Text As String)
    'Конец загрузке
    If Reg = 1 Then
        Reg = 2
        ObReg = ObReg + 1
        If ObReg = 2 Then Registr
    End If
End Sub

Private Sub WebBrowser1_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
    If ProgressMax > 0 Then Caption = "Загрузка:" & Str(Progress \ (ProgressMax \ 100)) & "%"
End Sub

'Название сайта
Private Sub WebBrowser1_TitleChange(ByVal Text As String)
    If strTitle = Text Then If Reg = 0 Then Reg = 1
End Sub

'===СЧЁТЧИК====
 'Начало загрузки сайта
Private Sub WebSchet_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
    If RegSchet< 2 Then
        If URL <> strURLSchet Then End
    End If
End Sub

Private Sub WebSchet_StatusTextChange(ByVal Text As String)
    'Конец загрузке
    If RegSchet = 1 Then
        RegSchet = 2
        ObReg = ObReg + 1
        If ObReg = 2 Then Registr
    End If
End Sub

'Название сайта
Private Sub WebSchet_TitleChange(ByVal Text As String)
    If strTitleSchet = Text Then If RegSchet = 0 Then RegSchet = 1
End Sub

'Завершение регистрации
Private Sub Registr()
    On Error Resume Next
    Open "Имя файла.ini" For Output As #1
    Close #1
End Sub

Скомпилируйте проект с именем Registr.exe.
3) Откройте проект основной программы. Добавьте код для проверки, пройдена ли регистрация.

Private Sub Form_Load()
    Dim H As String
    On Error Resume Next
    Open "Имя файла.ini" For Input As #1
        If Err Then
            H = "Необходимо зайти на сайт автора," & vbCrLf
            H = H & "с помощью программы ""Registr.exe"""
            MsgBox H, vbInformation
            End
        End If
    Close #1
End Sub

Вот и всё!
17 марта 2004г.

Заказ программ!

Вы можете заказать у меня написание необходимой вам программы. Чем популярнее будет она, тем меньше стоит работа.

Инфо

Сайт создан: 3 февраля 2000 г.

Главная страница