Полезные программы (собственные)

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by De-visible, 9 Jul 2008.

  1. kingbeef

    kingbeef Reservists Of Antichat

    Joined:
    8 Apr 2010
    Messages:
    367
    Likes Received:
    164
    Reputations:
    126
    перезалейте
     
    _________________________
  2. mr_walker

    mr_walker Member

    Joined:
    9 Aug 2009
    Messages:
    41
    Likes Received:
    34
    Reputations:
    2
    Многопоточный Прокси чекер

    Писал для себя на досуге, вот подумал, может кому-нибудь понадобится=)

    Многопоточный Прокси чекер
    возможности....ээмм..
    1. Чекать прокси хттп и соксы
    2. При старте прога берет список с файла proxies.txt
    [​IMG]

    Скачать: I'm hope this link alive=)
     
  3. Letcher

    Letcher New Member

    Joined:
    10 Nov 2011
    Messages:
    47
    Likes Received:
    4
    Reputations:
    0
    ShyRka_coder мне бы тоже такая программка пригодилась, поэтому тоже прошу перезалить
     
  4. xophet

    xophet Member

    Joined:
    16 Apr 2011
    Messages:
    617
    Likes Received:
    49
    Reputations:
    5
    Чет у меня на десктопе никаких картинок не появилось :(
     
  5. \\ChaOs//

    \\ChaOs// Member

    Joined:
    26 Feb 2009
    Messages:
    102
    Likes Received:
    26
    Reputations:
    5
    Иногда бывает пишу всякие безделушки, just fo fun. Может будут кому полезны.

    1. Transparency Controller

    Простая программа для управления прозрачностью у произвольных окон. Так же позволяет применить к любому окну эффект Aero Glass (2 метода).

    Особенности:
    1. Полностью настраиваемые горячие клавиши;
    2. Возможность применения Aero Glass к произвольному окну;
    3. Возможность применения эффекта Aero Glass к заданным программам автоматически;
    4. Иконка в трее (для изменения настроек, либо выхода из программы);
    5. Возможность задания шага изменения прозрачности.

    [​IMG]
    (кликабельно)

    [​IMG]

    Скачать бинарник и исходники можно на GitHub (на английском)

    Для тех, кто предпочитает русский интерфейс Для тех, кто какой-то другой — изменить его не составит труда, все строковые константы вынесены в Settings проекта.

    Обязательно иметь установленный .NET Framework 2.0 или выше.

    2. Screen Blocker

    Каждому из нас, наверно, приходилось блокировать компьютер, чтобы во время отсутствия никто ничего не натворил. Это программа поможет решить эту проблему. Чем это лучше Win+L спросите вы, — а тем, что можно спокойно наблюдать за происходящим на экране, но при этом быть уверенным, что без пароля никто компьютером не воспользуется.

    Особенности:
    1. Изменяемый пароль для разблокировки компьютера;
    2. Возможность наблюдать за тем, что происходит на компьютере во время блокировки;
    3. Неубиваемость программы (запускается на отдельном, защищенном рабочем столе, полностью изолированном от внешних воздействий);
    4. Приятный интерфейс с, уже наверное не модным, Aero Glass (работает даже на XP!).

    [​IMG]
    (кликабельно)

    ВАЖНО: Пароль по-умолчанию пустая строка (вводить ничего не нужно). Пароль всегда можно изменить.

    Скачать бинарник и исходники можно здесь .

    3. Forex Lot Compute

    Удобная программа для увлекающихся торговлей на рыне Forex. Помогает быстро вычислить необходимый лот для торговли в соответствии с вашими рисками.

    Особенности:
    1. Интерфейс в стиле Metro;
    2. Модульная структура позволяет самостоятельно написать и использовать желаемый провайдер котировок;
    3. Очень простой программный интерфейс для создания собственных модулей-провайдеров котировок. (необходимо реализовать лишь один метод, остальное программа берет на себя!

    В папке Providers содержится уже написанные провайдеры котировок. Для использования необходимо положить любой из них рядом с исполняемым файлом.

    [​IMG]

    Скачать бинарник и исходники можно здесь .

    Обязательно иметь установленный .NET Framework 4.0 или выше.
     
    #125 \\ChaOs//, 1 Apr 2012
    Last edited: 1 Apr 2012
    xackera, Yokohama-man, 1n0y and 2 others like this.
  6. Amd64

    Amd64 New Member

    Joined:
    10 Jan 2011
    Messages:
    24
    Likes Received:
    2
    Reputations:
    0
    Translit текста

    Смысл программы довольно прост.Бывает, что при переписке, приходится менять раскладку клавиатуры,в результате чего получается что-то похожее на это <<Ghbdtn!Rfr ltkf&>>. Данная программа поможет избавиться от этих проблем.

    Использование
    -Выделяем текст который необходимо перевести,и жмем ctrl+F1 -текст примет читабельный вид.

    Недостатки
    -Перевод не работает в ICQ(и некоторых других приложениях).Но думаю,что в скором времени это будет исправлено.
    --------------------------------

    В хроме и firefox всё работает без проблем(остальное не тестировал,но думаю проблем не возникнет),в текстовом редакторе тоже всё ок.Есть возможность добавить программу в автозагрузку.

    Какой в ней смысл?Уже есть Punto Switcher!
    Да,есть.Но лично меня он бесит,т.к текст переводится в совсем не нужный мне момент,а здесь я сам могу выбрать когда и какой текст мне переводить.
    Изначально прогу писал для личного пользования.Может кому-нибудь понравится, и кто-то захочет помочь в разработке,я буду только рад)Исходник и саму прогу можно скачать тут
    P.S Компилировал в Delphi 2010.
    [​IMG]
     
    #126 Amd64, 24 May 2012
    Last edited: 5 Jun 2012
  7. j0sur

    j0sur Member

    Joined:
    8 Apr 2012
    Messages:
    140
    Likes Received:
    7
    Reputations:
    0
    ConEd -- программа, созданая помочь в обработке больших текстовых файлов. Делалась для собственых нужд, так что user-friendly сомнительный.
    [​IMG]
    http://rghost.ru/38399141
     
    1 person likes this.
  8. Amd64

    Amd64 New Member

    Joined:
    10 Jan 2011
    Messages:
    24
    Likes Received:
    2
    Reputations:
    0
    Vk_Messages

    В интернете подобных не нашел,точнее нашел,но поддержка её закончилась в 2011 году...Прогу писал для себя,и естественно остался очень доволен
    Смысл в том,что если приходит новое сообщение Вконтакте,то появлялось звуковое оповещение.Вконтакте оно тоже есть,но этот "щелчок" я не всегда слышу,особенно когда играю во что-нибудь
    Программа получилась довольно простой,в большей части из-за компонентов.В общем,выкладываю сюда,может она еще кому-то нужна будет.Если кому интересен исходник-выложу исходник)

    [​IMG] [​IMG]

    Компилировал в Delphi 2010

    Сторонние компоненты: AlphaContrlos

    Программа

    Исходник

    Update: обновил программу,все изменения в файле history.txt

    Update:создал Группу

    в Vk все обновления в программе будут поститься там.Здесь больше ничего обновлять уже не буду.
     
    #128 Amd64, 12 Jul 2012
    Last edited: 14 Jul 2012
    1 person likes this.
  9. cyberXndr

    cyberXndr Member

    Joined:
    8 Jul 2012
    Messages:
    19
    Likes Received:
    5
    Reputations:
    6
    кинь пожалуйста исходник, интересна реализация авторизации
     
  10. shadowrun

    shadowrun Banned

    Joined:
    29 Aug 2010
    Messages:
    842
    Likes Received:
    170
    Reputations:
    84
    Методом Get без заморочек ...
     
  11. cyberXndr

    cyberXndr Member

    Joined:
    8 Jul 2012
    Messages:
    19
    Likes Received:
    5
    Reputations:
    6
    Ценность твоего комментария под сомнением.
     
  12. shadowrun

    shadowrun Banned

    Joined:
    29 Aug 2010
    Messages:
    842
    Likes Received:
    170
    Reputations:
    84
    Ценность твоего мышления под сомнением...
    Прога -> сниффер -> профит
     
  13. cyberXndr

    cyberXndr Member

    Joined:
    8 Jul 2012
    Messages:
    19
    Likes Received:
    5
    Reputations:
    6
    Заметь, я просил исходник, а не две очевидные строчки как это лучше сделать. Есть много путей, мне нужен исходник.
     
  14. Amd64

    Amd64 New Member

    Joined:
    10 Jan 2011
    Messages:
    24
    Likes Received:
    2
    Reputations:
    0
  15. 2echnoman

    2echnoman New Member

    Joined:
    3 Jul 2012
    Messages:
    54
    Likes Received:
    0
    Reputations:
    0
    Как-то понадобилась база ФИО из 3К записей. Искать в сети не было настроения. На глаза попался сайт rusprofile.ru. Короче все вылилось в грабер имен для этого сайта.
    Rusprofile.ru Name Graber
    [​IMG]
    Загрузить
     
  16. ham

    ham Member

    Joined:
    21 Jul 2011
    Messages:
    27
    Likes Received:
    5
    Reputations:
    0
    это же под линукс? Перезалей, плиз
     
  17. \\ChaOs//

    \\ChaOs// Member

    Joined:
    26 Feb 2009
    Messages:
    102
    Likes Received:
    26
    Reputations:
    5
    Писал для себе, но может кому будет полезным.

    [​IMG]

    Что умеет:
    • показывает аккорды
    • распознает аккорды
    • связь гитарного грифа с нотами (показывает где можно сыграть определенные ноты)
    • поддерживаются разные строи гитары
    • можно составлять и воспроизводить музыку
    • разные инструменты для воспроизведения

    Как пользоваться:
    Лады\ноты можно выбирать (правая кнопка мыши). Левой кнопкой проиграть звук (звучит, пока кнопка не отпущена)

    Как составлять музыку:
    Пишем через запятую, без пробелов, ноты, с указанием октав (A2,G3,C4). либо пишем нужный аккорд, начиная строку с символа @, потом указываем ноту (с октавой или без) аккорда и через пробел его тип (@A3 m - Ля минор 3-й октавы)

    Более подробно описано в Changelog.txt

    Проект находится на ГитХабе. Для запуска необходим .NET Framework 4(Client Profile версия тоже сойдет)
     
    #137 \\ChaOs//, 31 Jul 2012
    Last edited: 31 Jul 2012
  18. Kandi

    Kandi Member

    Joined:
    18 Nov 2009
    Messages:
    344
    Likes Received:
    17
    Reputations:
    0
    Писал для личных целей. Программа проверяет валидность DLE сайтов по списку.

    Исходники + *.exe на Sendspace - click for download


    [​IMG]


    Исходный код:
    Code:
    unit MainUnit;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, ComCtrls, Buttons, SyncObjs, Menus, IdHTTP, IdCompressorZLib;
    
    (* Главный класс *)
    type
      TMainForm = class(TForm)
        GBListHost: TGroupBox;
        LBHosts: TListBox;
        GBSpisok: TGroupBox;
        PBar: TProgressBar;
        REGood: TRichEdit;
        REBad: TRichEdit;
        BBStartCheck: TBitBtn;
        PopupMenu: TPopupMenu;
        NLoad: TMenuItem;
        NClear: TMenuItem;
        NSort: TMenuItem;
        OD: TOpenDialog;
        LGood: TLabel;
        LBad: TLabel;
        procedure BBStartCheckClick(Sender: TObject);
        procedure EndThread(Sender: TObject);
        procedure NLoadClick(Sender: TObject);
        procedure NClearClick(Sender: TObject);
        procedure NSortClick(Sender: TObject);
        procedure REGoodChange(Sender: TObject);
        procedure REBadChange(Sender: TObject);
      private
        { Private declarations }
        procedure CountHost;
      public
        { Public declarations }
      end;
    
    (* Класс потока *)
    type
      TThreadCheck = class(TThread)
      class var CheckOn : Boolean;
      class var Stop : Boolean;
      private
        { Private declarations }
      protected
        procedure Execute; override;
      end;
    
    var
      MainForm: TMainForm;
      CS : TCriticalSection;
      ThrCount : Integer;
      IndexCheck : Integer;
    
    implementation
    
    {$R *.dfm}
    
    procedure TMainForm.BBStartCheckClick(Sender: TObject);
    var
      I, CountThread: Integer;
    begin
      if TThreadCheck.CheckOn then
        Exit;
      if LBHosts.Items.Count <= 0 then
        begin
          MessageBox(0, 'Загрузите список...', 'Error', MB_OK + MB_ICONSTOP);
          Exit;
        end;
      PBar.Position := 0;
      PBar.Min := 0;
      PBar.Max := LBHosts.Items.Count;
      CS := TCriticalSection.Create;
      IndexCheck := 0;
      ThrCount := 0;
      TThreadCheck.CheckOn := True;
      TThreadCheck.Stop := False;
      (* Проверка потоков *)
      CountThread := 1;
      if LBHosts.Items.Count > 100 then
        CountThread := 10;
      if LBHosts.Items.Count > 300 then
        CountThread := 30;
      if LBHosts.Items.Count > 500 then
        CountThread := 50;
      for I := 1 to CountThread do
        begin
          Application.ProcessMessages;
          with TThreadCheck.Create(True) do
            begin
              FreeOnTerminate := True;
              Priority := tpLowest;
              OnTerminate := Self.EndThread;
              Resume;
            end;
        end;
      BBStartCheck.Enabled := False;
    end;
    
    procedure TMainForm.CountHost;
    begin
      if LBHosts.Items.Count > 0 then
        GBListHost.Caption := 'Список сайтов | ' + IntToStr(LBHosts.Items.Count)
      else
        GBListHost.Caption := 'Список сайтов';
    end;
    
    procedure TMainForm.EndThread(Sender: TObject);
    begin
      Dec(ThrCount);
      if ThrCount = 0 then
        begin
          TThreadCheck.CheckOn := False;
          TThreadCheck.Stop := True;
          FreeAndNil(CS);
          PBar.Position := LBHosts.Items.Count;
          BBStartCheck.Enabled := True;
          MessageBox(0, PWideChar('Проверка успешно завершена!' + #13#10 +
                                  'Хороших сайтов: ' + IntToStr(REGood.Lines.Count) + #13#10 +
                                  'Плохих сайтов: ' + IntToStr(REBad.Lines.Count)), 'Info', MB_OK + MB_ICONINFORMATION);
          PBar.Position := 0;
        end;
    end;
    
    procedure TMainForm.NClearClick(Sender: TObject);
    begin
      LBHosts.Clear;
      CountHost;
    end;
    
    procedure TMainForm.NLoadClick(Sender: TObject);
    begin
      OD.InitialDir := GetCurrentDir;
      OD.FileName := '';
      LBHosts.Clear;
      if OD.Execute then
        begin
          LBHosts.Items.LoadFromFile(OD.FileName);
        end
        else
          Exit;
      CountHost;
    end;
    
    procedure TMainForm.NSortClick(Sender: TObject);
    var
      TMP : TSTringList;
    begin
      if LBHosts.Items.Count <= 0 then
        begin
          MessageBox(0, 'Не возможно сортировать список...', 'Error', MB_OK + MB_ICONSTOP);
          Exit;
        end;
      TMP := TStringList.Create;
      try
        TMP.Sorted := True;
        TMP.Assign(LBHosts.Items);
        LBHosts.Clear;
        LBHosts.Items.Assign(TMP);
      finally
        FreeAndNil(TMP);
      end;
      CountHost;
    end;
    
    procedure TMainForm.REBadChange(Sender: TObject);
    begin
      LBad.Caption := 'Кол-во: ' + IntToStr(REBad.Lines.Count);
    end;
    
    procedure TMainForm.REGoodChange(Sender: TObject);
    begin
      LGood.Caption := 'Кол-во: ' + IntToStr(REGood.Lines.Count);
    end;
    
    procedure TThreadCheck.Execute;
    var
      HTTP : TIdHTTP;
      Compress : TIdCompressorZLib;
      S, Url : String;
    begin
      InterlockedIncrement(ThrCount);
      Sleep(Random(1000));
      try
        while (not Stop) do
          begin // not Stop
            (* Создаём HTTP *)
            HTTP := TIdHTTP.Create(nil);
            Compress := TIdCompressorZLib.Create(nil);
            HTTP.HandleRedirects := True;
            HTTP.AllowCookies := True;
            HTTP.Compressor := Compress;
            HTTP.ReadTimeout := 10000;
            HTTP.ConnectTimeout := 10000;
            (* Заголовки для сайта *)
            HTTP.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:12.0) Gecko/20100101 Firefox/12.0';
            HTTP.Request.Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
            HTTP.Request.AcceptLanguage := 'ru-ru,ru;q=0.8,en-us;q=0.5,en;q=0.3';
            HTTP.Request.Connection := 'keep-alive';
            try
              CS.Enter;
                if IndexCheck >= MainForm.LBHosts.Items.Count then exit;
                Url := MainForm.LBHosts.Items.Strings[IndexCheck];
                Inc(IndexCheck);
            finally
              CS.Leave;
            end;
            (* Проверка ссылки *)
            Url := LowerCase(Url);
            if Pos('http://', Url) > 0 then
              Url := StringReplace(Url, 'http://', '', [rfReplaceAll, rfIgnoreCase]);
            if Pos('www.', Url) > 0 then
              Url := StringReplace(Url, 'www.', '', [rfReplaceAll, rfIgnoreCase]);
            if Pos('/', Url) > 0 then
              Url := StringReplace(Url, '/', '', [rfReplaceAll, rfIgnoreCase]);
            Url := 'http://' + Url;
            (* Заходим на сервер *)
            try
              S := '';
              S := HTTP.Get(Url);
            except
    
            end;
            Synchronize(procedure begin MainForm.PBar.Position := MainForm.PBar.Position + 1; end);
            (* Проверка ответа от сервера *)
            if (Pos('do=register', S) > 0) or (Pos('do=register', S) > 0) or (Pos('do=lostpassword', S) > 0) then
              begin
                (* Нормальный DLE *)
                Synchronize(procedure begin MainForm.REGood.SelStart := Length(MainForm.REGood.Text); MainForm.REGood.Lines.Append(Url); end);
              end
              else
              begin
                (* Плохой DLE *)
                Synchronize(procedure begin MainForm.REBad.SelStart := Length(MainForm.REBad.Text); MainForm.REBad.Lines.Append(Url); end);
              end;
            (* Чистим за собой :) *)
            FreeAndNil(HTTP);
            FreeAndNil(Compress);
          end; // not Stop
      finally
    
      end;
    end;
    
    end.
    
    P.S. Надеюсь кому-то пригодится! :rolleyes:
     
    #138 Kandi, 17 Sep 2012
    Last edited: 20 Sep 2012
  19. Kandi

    Kandi Member

    Joined:
    18 Nov 2009
    Messages:
    344
    Likes Received:
    17
    Reputations:
    0
    Небольшой флудер с HTTP прокси для Ask.fm - был создан для себя можно сказать на коленках) ну всё же проверен несколько раз)

    [​IMG]

    MainUnit.pas
    Code:
    unit MainUnit;
    
    interface
    
    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
      Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons,
      Vcl.ComCtrls, System.SyncObjs, Vcl.ExtCtrls, Vcl.Imaging.pngimage, ShellAPI;
    
    type
      TMainForm = class(TForm)
        GBFlooderSettings: TGroupBox;
        Label1: TLabel;
        EUserName: TEdit;
        Label2: TLabel;
        EFileQuestions: TEdit;
        BBStart: TBitBtn;
        BBStop: TBitBtn;
        GBProxySettings: TGroupBox;
        Label3: TLabel;
        ETimeOutConnect: TEdit;
        Label4: TLabel;
        EFileProxy: TEdit;
        SBar: TStatusBar;
        TimerUpdate: TTimer;
        ImgLogo: TImage;
        Label5: TLabel;
        EThreadCount: TEdit;
        procedure EndThreadBrute(Sender: TObject);
        procedure BBStartClick(Sender: TObject);
        procedure BBStopClick(Sender: TObject);
        procedure TimerUpdateTimer(Sender: TObject);
        procedure ImgLogoClick(Sender: TObject);
        procedure EThreadCountChange(Sender: TObject);
      private
        { Private declarations }
        procedure FormOff;
        procedure FormOn;
      public
        { Public declarations }
      end;
    
    var
      MainForm: TMainForm;
      (* Глобальные переменные *)
      CS : TCriticalSection;
      ThreadCount, ErrorCount, SendCount : Integer;
      FileProxy, FileQuestion : TextFile;
    
    implementation
    
    {$R *.dfm}
    
    uses ThreadFlooderAskUnit;
    
    procedure TMainForm.BBStartClick(Sender: TObject);
    var
      I : Integer;
    begin
      if TThreadFlooderAsk.OnWork then
        begin
          MessageBox(0, 'Threads already work.', 'Error', MB_OK + MB_ICONSTOP);
          Exit;
        end;
      if StrToInt(ETimeOutConnect.Text) < 5000 then
        begin
          MessageBox(0, PChar('Min proxy timeout connect - 5000 msek.'), 'Error', MB_OK + MB_ICONSTOP);
          Exit;
        end;
      (* Проверка файла вопросов *)
      if not FileExists(GetCurrentDir + '/' + EFileQuestions.Text) then
        begin
          MessageBox(0, PChar('Not found questions file - ' + EFileQuestions.Text + '.'), 'Error', MB_OK + MB_ICONSTOP);
          Exit;
        end;
      (* Проверка файла прокси *)
      if not FileExists(GetCurrentDir + '/' + EFileProxy.Text) then
        begin
          MessageBox(0, PChar('Not found proxy file - ' + EFileProxy.Text + '.'), 'Error', MB_OK + MB_ICONSTOP);
          Exit;
        end;
      FormOff;
      (* Открываем файл на чтение *)
      AssignFile(FileQuestion, GetCurrentDir + '/' + EFileQuestions.Text);
      FileMode := fmOpenRead;
      Reset(FileQuestion);
      AssignFile(FileProxy, GetCurrentDir + '/' + EFileProxy.Text);
      FileMode := fmOpenRead;
      Reset(FileProxy);
      (* Настраиваем глобалки *)
      ThreadCount := 0;
      SendCount := 0;
      ErrorCount := 0;
      CS := TCriticalSection.Create;
      (* Запускаем потоки *)
      TimerUpdate.Enabled := True;
      TThreadFlooderAsk.OnWork := True;
      TThreadFlooderAsk.Stop := False;
      for I := 1 to StrToInt(EThreadCount.Text) do
        begin
          Application.ProcessMessages;
          with TThreadFlooderAsk.Create(True, EUserName.Text, ETimeOutConnect.Text) do
            begin
              FreeOnTerminate := True;
              Priority := tpLowest;
              OnTerminate := Self.EndThreadBrute;
              Resume;
            end;
          Inc(ThreadCount);
        end;
    end;
    
    procedure TMainForm.BBStopClick(Sender: TObject);
    begin
      if TThreadFlooderAsk.OnWork then
        TThreadFlooderAsk.Stop := True;
    end;
    
    procedure TMainForm.EndThreadBrute(Sender: TObject);
    begin
      Dec(ThreadCount);
      if ThreadCount = 0 then
        begin
          TThreadFlooderAsk.OnWork := False;
          TThreadFlooderAsk.Stop := True;
          FreeAndNil(CS);
          CloseFile(FileProxy);
          CloseFile(FileQuestion);
          FormOn;
        end;
    end;
    
    procedure TMainForm.EThreadCountChange(Sender: TObject);
    begin
      if StrToInt(EThreadCount.Text) = 0 then
        EThreadCount.Text := '1';
    end;
    
    procedure TMainForm.FormOff;
    begin
      EUserName.Enabled := False;
      EFileQuestions.Enabled := False;
      ETimeOutConnect.Enabled := False;
      EFileProxy.Enabled := False;
      EThreadCount.Enabled := False;
      BBStart.Enabled := False;
      BBStop.Enabled := True;
    end;
    
    procedure TMainForm.FormOn;
    begin
      EUserName.Enabled := True;
      EFileQuestions.Enabled := True;
      ETimeOutConnect.Enabled := True;
      EFileProxy.Enabled := True;
      EThreadCount.Enabled := True;
      BBStart.Enabled := True;
      BBStop.Enabled := False;
    end;
    
    procedure TMainForm.ImgLogoClick(Sender: TObject);
    begin
      ShellExecute(0, 'Open', PChar('https://forum.antichat.ru/member.php?u=104415'), nil, nil, SW_SHOWNORMAL);
    end;
    
    procedure TMainForm.TimerUpdateTimer(Sender: TObject);
    begin
      SBar.Panels[0].Text := 'Потоки: ' + IntToStr(ThreadCount) + ' шт. / Отправленно: ' + IntToStr(SendCount) + ' шт. / Ошибок: ' + IntToStr(ErrorCount) + ' шт.';
      if not TThreadFlooderAsk.OnWork then
        TimerUpdate.Enabled := False;
    end;
    
    end.
    
    ThreadFlooderAskUnit.pas
    Code:
    unit ThreadFlooderAskUnit;
    
    interface
    
    uses
      System.Classes, System.SysUtils, System.SyncObjs, Winapi.Windows, IdHTTP,
      IdCompressorZLib;
    
    type
      TThreadFlooderAsk = class(TThread)
      class var OnWork : Boolean;
      class var Stop : Boolean;
      private
        { Private declarations }
        ALoginFlood : String;
        AProxyTimeOut : Integer;
      protected
        procedure Execute; override;
      public
        constructor Create(CreateSuspennded: Boolean;
                           const LoginFlood, ProxyTimeOut: String);
      end;
    
    implementation
    
    { TThreadFlooderAsk }
    
    uses MainUnit;
    
    constructor TThreadFlooderAsk.Create(CreateSuspennded: Boolean;
      const LoginFlood, ProxyTimeOut: String);
    begin
      inherited Create(CreateSuspennded);
      ALoginFlood := LoginFlood;
      AProxyTimeOut := StrToInt(ProxyTimeOut);
    end;
    
    procedure TThreadFlooderAsk.Execute;
    var
      HTTP : TIdHTTP;
      Compress : TIdCompressorZLib;
      Post : TStringList;
      Response, Question, Proxy, IP, AUTH_TOKEN : String;
      Port : Integer;
      FlagProxy : Boolean;
    begin
      Post := TStringList.Create;
      try
        while (not Stop) do
          begin
            (* Читаем файл вопросов *)
            try
              CS.Enter;
              try
                (* Проверяем конец строк *)
                if Eof(FileProxy) then break;
                (* Проверяем конец строк *)
                if Eof(FileQuestion) then break;
                (* Читаем строку *)
                Readln(FileQuestion, Question);
              except
    
              end;
            finally
              CS.Leave;
            end;
            (* Крутим цикл прокси *)
            FlagProxy := True;
            while FlagProxy and (not Stop) do
              begin
                (* Читаем файл прокси *)
                try
                  CS.Enter;
                  try
                    (* Проверяем конец строк *)
                    if Eof(FileProxy) then break;
                    (* Читаем строку *)
                    Readln(FileProxy, Proxy);
                  except
    
                  end;
                finally
                  CS.Leave;
                end;
                (* Проверка *)
                if Proxy = '' then
                  continue;
                IP := Copy(Proxy, 0, Pos(':', Proxy) - 1);
                Proxy := Copy(Proxy, Pos(':', Proxy) + 1, Length(Proxy));
                if not TryStrToInt(Proxy, Port) then
                  continue;
                (* Создаём HTTP *)
                HTTP := TIdHTTP.Create(nil);
                HTTP.HandleRedirects := True;
                HTTP.AllowCookies := False;
                Compress := TIdCompressorZLib.Create(nil);
                HTTP.Compressor := Compress;
                (* Задаём заголовки *)
                HTTP.Request.Host := 'ask.fm';
                HTTP.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:15.0) Gecko/20100101 Firefox/15.0.1'{USER_AGENTS[Random(21)]};
                HTTP.Request.Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
                HTTP.Request.AcceptLanguage := 'ru-RU,ru;q=0.8,en-US;q=0.5,en;q=0.3';
                HTTP.Request.CharSet := 'windows-1251,utf-8;q=0.7,*;q=0.7';
                HTTP.Request.Connection := 'keep-alive';
                (* Настройка прокси *)
                HTTP.ConnectTimeout := AProxyTimeOut;
                HTTP.ReadTimeout := AProxyTimeOut;
                HTTP.ProxyParams.ProxyServer := IP;
                HTTP.ProxyParams.ProxyPort := Port;
                try
                  (* Пытаем подключиться *)
                  try
                    Response := '';
                    Response := HTTP.Get('http://ask.fm/' + ALoginFlood);
                  except
    
                  end;
                  (* Проверяем ответ *)
                  if (HTTP.ResponseCode <> 200) and (Pos('var AUTH_TOKEN =', Response) = 0) then
                    begin
                      InterlockedIncrement(ErrorCount);
                      continue;
                    end;
                  AUTH_TOKEN := Copy(Response, Pos('var AUTH_TOKEN =', Response) + 18, Length(Response));
                  AUTH_TOKEN := Copy(AUTH_TOKEN, 0, Pos('";', AUTH_TOKEN) - 1);
                  if AUTH_TOKEN = '' then
                    continue;
                  (* Генерируем запрос *)
                  Post.Clear;
                  Post.Append('authenticity_token=' + AUTH_TOKEN);
                  Post.Append('question[question_text]=' + Question);
                  Post.Append('authenticity_token=' + AUTH_TOKEN);
                  try
                    HTTP.Request.Accept := 'text/javascript';
                    HTTP.Request.ContentType := 'application/x-www-form-urlencoded; charset=UTF-8';
                    HTTP.Request.Referer := 'http://ask.fm/' + ALoginFlood;
                    HTTP.Request.CustomHeaders.Append('X-Requested-With: XMLHttpRequest');
                    Response := '';
                    Response := HTTP.Post('http://ask.fm/' + ALoginFlood + '/questions/create', Post);
                  except
    
                  end;
                  if (HTTP.ResponseCode = 200) and (Pos('authenticity_token', Response) > 0) then
                    begin
                      // Send Good
                      InterlockedIncrement(SendCount);
                      (* Читаем новый вопрос *)
                      try
                        CS.Enter;
                        try
                          (* Проверяем конец строк *)
                          if Eof(FileQuestion) then break;
                          (* Читаем строку *)
                          Readln(FileQuestion, Question);
                        except
    
                        end;
                      finally
                        CS.Leave;
                      end;
                    end
                    else
                    begin
                      // Error
                      InterlockedIncrement(ErrorCount);
                    end;
                finally
                  FreeAndNil(HTTP);
                  FreeAndNil(Compress);
                end;
              end;
          end; // not Stop
      finally
        FreeAndNil(Post);
      end;
    end;
    
    end.
    

    Скачать ->
    SendSpace *.exe + souce code


    Скачать ->
    RGHost *.exe + souce code Пароль: antichat
     
    1 person likes this.
  20. tester_new

    tester_new Elder - Старейшина

    Joined:
    12 Feb 2012
    Messages:
    300
    Likes Received:
    45
    Reputations:
    24
    #140 tester_new, 27 Oct 2013
    Last edited: 27 Oct 2013
Loading...
Similar Threads - Полезные программы собственные
  1. Peja
    Replies:
    0
    Views:
    2,549