Обсуждение Программирование на Delphi/Pascal

Награды
7
Всем привет! Еще раз обращусь за помощью. :)
Подскажите, пожалуйста, в каком направлении копать! Задача следующая (реализовано, но много одинаковой писанины):
1. На форме есть memo1, например с 5-ю строками данных
2. В основном модуле динамически создается IdHttp, через который программа логинится на сайт. Куки сохраняются в отдельной переменной. После логина основной поток запускает 5 дополнительных потоков из 5-ти дополнительных модулей.
3. В дополнительных модулях (5 шт, как и кол-во строк в memo1) описан поток со своим, динамически созданном, IdHttp. Куки скопированы из глобальной переменной. Каждый модуль берет свою строку из memo1 (1-й модуль - первую, 2-й - 2-ю....) и POST запросом отправляет на сайт.
Так вот вопрос! Можно ли создавать потоки, исходя из кол-ва строк в memo1 и не писать на каждый поток свой модуль!?
Фактически получается, что каждый дополнительный поток делает одну и ту же работу, только данные берет из разных строк memo1.
Я чего то не понял. А зачем пять модулей (кстати, модуль это что? unit?) в каждом из которых по потоку? Каждый из этих потоков свою строку обрабатывает как-то по своему или идентично? Ты бы код привел в качестве примера чтоль, а то как-то всё непонятно.

А потоков можно создавать сколько угодно, пока хватит системных ресурсов. Ну и сразу скажу, если ты используешь глобальные переменные, значит код с вероятностью 99.(9)% написан неправильно.
 
Всем привет! Еще раз обращусь за помощью. :)
Подскажите, пожалуйста, в каком направлении копать! Задача следующая (реализовано, но много одинаковой писанины):
1. На форме есть memo1, например с 5-ю строками данных
2. В основном модуле динамически создается IdHttp, через который программа логинится на сайт. Куки сохраняются в отдельной переменной. После логина основной поток запускает 5 дополнительных потоков из 5-ти дополнительных модулей.
3. В дополнительных модулях (5 шт, как и кол-во строк в memo1) описан поток со своим, динамически созданном, IdHttp. Куки скопированы из глобальной переменной. Каждый модуль берет свою строку из memo1 (1-й модуль - первую, 2-й - 2-ю....) и POST запросом отправляет на сайт.
Так вот вопрос! Можно ли создавать потоки, исходя из кол-ва строк в memo1 и не писать на каждый поток свой модуль!?
Фактически получается, что каждый дополнительный поток делает одну и ту же работу, только данные берет из разных строк memo1.
Я чего то не понял. А зачем пять модулей (кстати, модуль это что? unit?) в каждом из которых по потоку? Каждый из этих потоков свою строку обрабатывает как-то по своему или идентично? Ты бы код привел в качестве примера чтоль, а то как-то всё непонятно.

А потоков можно создавать сколько угодно, пока хватит системных ресурсов. Ну и сразу скажу, если ты используешь глобальные переменные, значит код с вероятностью 99.(9)% написан неправильно.

Модуль - имел в виду unit, в каждом поток. Поток обрабатывает своя строку идентично.

Я понимаю, что потоков можно создать сколько угодно. И пример привел с пятью потоками просто, как пример (это относится и к вопросу, а зачем пять модулей).

Код:
procedure send01.Execute;
var
  code, str, tmp: string;
  http: TIdHttp;
  pulya : TStringList;

begin
  n := 0;   // Это сделал для удобства, при копировании нескольких юнитов
  code := Form1.Memo2.Lines[n];
  If code = '' Then Exit;
  Http:= TIdHttp.Create(Nil);
  http.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:19.0) Gecko/20100101 Firefox/19.0';
  http.Request.AcceptLanguage := 'ru-RU,ru;q=0.8,en-US;q=0.5,en;q=0.3';
  http.HandleRedirects := true;
  http.AllowCookies := true;
  http.Request.CustomHeaders.Text := Unit1.cookie;
  pulya:= Tstringlist.Create;
  pulya.Add ('Data=' + code);
  While Unit1.start_thread = false Do
    begin
      Sleep(10);
    end;

  try
    str := Http.Post('http://*****', pulya);
  except
  end;
end;
 
Награды
7
Да лучше бы всю программу привёл. Чувствую там у тебя трэш, угар и содомия. :)

Правильно ли я понял? У тебя объявлено несколько unit-ов. В каждом unit-е объявлен свой класс потока send01, send02 и т.д. - наследник от TThread, но все эти наследники практически идентичны? Содержимое метода Execute отличается только на одну строку где переменной n присваивается значение. Так?

Кстати, не вижу n в списке локальных переменных метода Execute. Оно у тебя что является членом класса send01? Или вообще глобальной переменной?
 
Да лучше бы всю программу привёл. Чувствую там у тебя трэш, угар и содомия. :)

Правильно ли я понял? У тебя объявлено несколько unit-ов. В каждом unit-е объявлен свой класс потока send01, send02 и т.д. - наследник от TThread, но все эти наследники практически идентичны? Содержимое метода Execute отличается только на одну строку где переменной n присваивается значение. Так?

Кстати, не вижу n в списке локальных переменных метода Execute. Оно у тебя что является членом класса send01? Или вообще глобальной переменной?

Да, все правильно. А переменную n и правда что то я в глобальные запихнул...

Вся программа слишком "приватна" :) Я понимаю, что очень далек от идеала, но программа работает.
 
Награды
7
Если смотреть по этому коду, то замечания почти по каждой строке.
Код:
procedure [COLOR=#ff0000]send01[/COLOR].Execute;

[COLOR=#000080]Наименования классов в Delphi должны начинаться с T. Это такое соглашение.[/COLOR]

var
  code, str, tmp: string;
  http: TIdHttp;
  pulya : TStringList;

[COLOR=#000080]Наименования идентификаторов должны быть записаны в captitalised стиле, т.е. корни слова выделяются заглавной буквой - Code, Str, ByteCount и т.п.[/COLOR] [COLOR=#000080]Если идентификатор представляет собой аббревиатуру, то можно писать всё заглавными - HTTP, TIFF, GIF и т.п., но лучше придумать какое-нибудь другое имя.[/COLOR]

begin
  n := 0;   // Это сделал для удобства, при копировании нескольких юнитов
  code := [COLOR=#ff0000]Form1[/COLOR].Memo2.Lines[n];

[COLOR=#000080]  Глобальные переменные (в данном случае Form1) - зло. Вообще, абсолютно всю информацию, необходимую любому классу можно передать в конструкторе или через его свойства.
[/COLOR]
  [COLOR=#ff0000]If[/COLOR] code = '' [COLOR=#ff0000]Then[/COLOR] [COLOR=#ff0000]Exit[/COLOR];

[COLOR=#000080]exit, goto, Break, Сontinue относятся к разряду вещей которые надо использовать как можно реже, а в идеале никогда. Можно было бы написать:

if code <> '' then
begin
  ...
end;
[/COLOR]
  Http:= TIdHttp.Create([COLOR=#ff0000]Nil[/COLOR]);

[COLOR=#000080]Создание экземпляра класса должно защищаться блоком try ... finally ... end если у этого класса нет никакого владельца. В противном случае есть риск получения утечки памяти.[/COLOR] [COLOR=#000080]nil, if, then - зарезервированные слова и поэтому должны писаться с маленькой буквы.[/COLOR]
[COLOR=#000080]
HTTP := TIdHttp.Create(nil);
try
  HTTP.Request.UserAgent := ....
  ...
finally
  HTTP.Free;
end;

или

finally
  FreeAndNil(HTTP);
end;
[/COLOR]
  http.Request.UserAgent := [COLOR=#ff0000]'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:19.0) Gecko/20100101 Firefox/19.0'[/COLOR];
  http.Request.AcceptLanguage := [COLOR=#ff0000]'ru-RU,ru;q=0.8,en-US;q=0.5,en;q=0.3'[/COLOR];

[COLOR=#000080]Строковые литералы жестко закодированные в коде вместо констант, потенциальная жопа.[/COLOR]

  http.HandleRedirects := true;
  http.AllowCookies := true;

[COLOR=#000080]True и False - идентификаторы, а не зарезервированные слова и поэтому пишутся с большой буквы.[/COLOR]

  http.Request.CustomHeaders.Text := [COLOR=#ff0000]Unit1.cookie[/COLOR];

[COLOR=#000080]Глобальные переменные - зло.[/COLOR]

  pulya:= Tstringlist.Create;

[COLOR=#000080]try ... finally ... end отсутствует[/COLOR]

  pulya.Add ('Data=' + code);
[COLOR=#ff0000]  While Unit1.start_thread = false Do
    begin
      Sleep(10);
    end;[/COLOR]

[COLOR=#000080]"Жесткий" цикл - 100% потребления CPU гарантированы.[/COLOR]

  try
    str := Http.Post('http://*****', pulya);
  except
     [COLOR=#ff0000]пусто[/COLOR] 
  end;

[COLOR=#000080]Маскировка исключений пустым except ... end приводит к трудноуловимым ошибкам, т.к. данный except ловит всё. В том числе и EAccessViolation, EPrivilegedInstruction и ещё чёрта лысого.[/COLOR]

end;
 
Награды
7
Да, все правильно. А переменную n и правда что то я в глобальные запихнул...

Вся программа слишком "приватна" :) Я понимаю, что очень далек от идеала, но программа работает.
Можешь выковырять из неё куски кода непосредственно относящиеся к её секретной части, оставив только скелет. По поводу "программа работает"... я сейчас занимаюсь сопровождением программного продукта содержащего несколько миллионов строк кода. Там тоже начальник говорил "программа работает" оправдывая кривые решения разного уровня, от кодирования до архитектуры, а теперь выливается всё в то что для внесения каких-то тривиальных правок приходится тратить очень много времени.
 
Награды
7
Вот пример как используя только один класс потока, не используя никаких глобальных переменных и нескольких юнитов насоздавать кучу потоков, выдав каждому по личному заданию. Пример тупо берёт строки из мемо и записывает их в разные файлы. Имена файлов генерятся по принципу Greeting<номер строки>.txt.

Unit1.pas - собственно форма с мемо
Код:
unit Unit1;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    memData: TMemo;
    btnWrite: TButton;
    procedure btnWriteClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  System.IOUtils,
  Unit2;

const
  TextFileName = 'Greeting%d.txt';

resourcestring
  WriterFailed = 'The writer thread %d has raised an exception. Exception class %s. Message: "%s".';

procedure TForm1.btnWriteClick(Sender: TObject);
var
  CurrentLine, CurrentWriter: Integer;
  GreetingWriters: TGreetingWriterList;
  Writer: TGreetingWriter;
  E: Exception;
begin
  GreetingWriters := TGreetingWriterList.Create(True);
  try
    for CurrentLine := 0 to memData.Lines.Count - 1 do
    begin
      Writer := TGreetingWriter.Create(True, TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), Format(TextFileName, [CurrentLine])), memData.Lines[CurrentLine]);
      try
        GreetingWriters.Add(Writer);
      except
        FreeAndNil(Writer);
        raise;
      end;
    end;
    for CurrentWriter := 0 to GreetingWriters.Count - 1 do
      GreetingWriters[CurrentWriter].Start;
    // довольно дубовый метод ожидания выполнения всех потоков, но для простоты сойдёт и этот
    for CurrentWriter := 0 to GreetingWriters.Count - 1 do
    begin
      Writer := GreetingWriters[CurrentWriter];
      Writer.WaitFor;
      if Writer.FatalException <> nil then
      begin
        E := Writer.FatalException as Exception;
        MessageDlg(Format(WriterFailed, [CurrentWriter, E.ClassName, E.Message]), mtError, [mbOk], 0);
      end;
    end;
  finally
    FreeAndNil(GreetingWriters);
  end;
end;

end.

Unit2.pas - собственно поток который получает в конструктор имя файла, строку которую надо записать и пишет её.
Код:
unit Unit2;

interface

uses
  System.Classes,
  Generics.Collections;

type
  TGreetingWriter = class(TThread)
  strict private
    FFileName: string;
    FGreeting: string;
  strict protected
    property FileName: string read FFileName;
    property Greeting: string read FGreeting;
  protected
    procedure Execute; override;
  public
    constructor Create(const CreateSuspended:Boolean; const aFileName, aGreeting: string);
  end;

  TGreetingWriterList = class(TObjectList<TGreetingWriter>);

implementation
uses
  System.SysUtils;

{ TGreetingWriter }

constructor TGreetingWriter.Create(const CreateSuspended:Boolean; const aFileName, aGreeting: string);
begin
  inherited Create(CreateSuspended);
  Assert(aFileName <> '');
  FFileName := aFileName;
  FGreeting := aGreeting;
end;

procedure TGreetingWriter.Execute;
var
  Stream: TStream;
  Writer: TStreamWriter;
begin
  Stream:=TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
  try
    Writer:=TStreamWriter.Create(Stream, TEncoding.Unicode);
    try
      Writer.Write(Greeting);
    finally
      FreeAndNil(Writer);
    end;
  finally
    FreeAndNil(Stream);
  end;
end;

end.

Программа запускалась ровно один раз, так что если чо, не взыщите.
 
Вот пример как используя только один класс потока, не используя никаких глобальных переменных и нескольких юнитов насоздавать кучу потоков, выдав каждому по личному заданию. Пример тупо берёт строки из мемо и записывает их в разные файлы. Имена файлов генерятся по принципу Greeting<номер строки>.txt.

Unit1.pas - собственно форма с мемо
Код:
unit Unit1;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    memData: TMemo;
    btnWrite: TButton;
    procedure btnWriteClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  System.IOUtils,
  Unit2;

const
  TextFileName = 'Greeting%d.txt';

resourcestring
  WriterFailed = 'The writer thread %d has raised an exception. Exception class %s. Message: "%s".';

procedure TForm1.btnWriteClick(Sender: TObject);
var
  CurrentLine, CurrentWriter: Integer;
  GreetingWriters: TGreetingWriterList;
  Writer: TGreetingWriter;
  E: Exception;
begin
  GreetingWriters := TGreetingWriterList.Create(True);
  try
    for CurrentLine := 0 to memData.Lines.Count - 1 do
    begin
      Writer := TGreetingWriter.Create(True, TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), Format(TextFileName, [CurrentLine])), memData.Lines[CurrentLine]);
      try
        GreetingWriters.Add(Writer);
      except
        FreeAndNil(Writer);
        raise;
      end;
    end;
    for CurrentWriter := 0 to GreetingWriters.Count - 1 do
      GreetingWriters[CurrentWriter].Start;
    // довольно дубовый метод ожидания выполнения всех потоков, но для простоты сойдёт и этот
    for CurrentWriter := 0 to GreetingWriters.Count - 1 do
    begin
      Writer := GreetingWriters[CurrentWriter];
      Writer.WaitFor;
      if Writer.FatalException <> nil then
      begin
        E := Writer.FatalException as Exception;
        MessageDlg(Format(WriterFailed, [CurrentWriter, E.ClassName, E.Message]), mtError, [mbOk], 0);
      end;
    end;
  finally
    FreeAndNil(GreetingWriters);
  end;
end;

end.

Unit2.pas - собственно поток который получает в конструктор имя файла, строку которую надо записать и пишет её.
Код:
unit Unit2;

interface

uses
  System.Classes,
  Generics.Collections;

type
  TGreetingWriter = class(TThread)
  strict private
    FFileName: string;
    FGreeting: string;
  strict protected
    property FileName: string read FFileName;
    property Greeting: string read FGreeting;
  protected
    procedure Execute; override;
  public
    constructor Create(const CreateSuspended:Boolean; const aFileName, aGreeting: string);
  end;

  TGreetingWriterList = class(TObjectList<TGreetingWriter>);

implementation
uses
  System.SysUtils;

{ TGreetingWriter }

constructor TGreetingWriter.Create(const CreateSuspended:Boolean; const aFileName, aGreeting: string);
begin
  inherited Create(CreateSuspended);
  Assert(aFileName <> '');
  FFileName := aFileName;
  FGreeting := aGreeting;
end;

procedure TGreetingWriter.Execute;
var
  Stream: TStream;
  Writer: TStreamWriter;
begin
  Stream:=TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
  try
    Writer:=TStreamWriter.Create(Stream, TEncoding.Unicode);
    try
      Writer.Write(Greeting);
    finally
      FreeAndNil(Writer);
    end;
  finally
    FreeAndNil(Stream);
  end;
end;

end.

Программа запускалась ровно один раз, так что если чо, не взыщите.
Спасибо! Завтра погляжу и свою подкорректирую для публикации.
 
Unit1:
Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, idhttp, send1, send2, send3, send4, send5, send6, send7, send8, send9, send10;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Edit_Hour: TEdit;
    Edit_Minute: TEdit;
    Edit_Sec: TEdit;
    Edit_MSec: TEdit;
    UpDown1: TUpDown;
    UpDown2: TUpDown;
    UpDown3: TUpDown;
    UpDown4: TUpDown;
    CheckBox1: TCheckBox;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    Memo1: TMemo;
    Memo2: TMemo;
    Timer1: TTimer;
    Button1: TButton;
    Button2: TButton;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Edit_Hour1: TEdit;
    Edit_Minute1: TEdit;
    Edit_Sec1: TEdit;
    Edit_MSec1: TEdit;
    UpDown5: TUpDown;
    UpDown6: TUpDown;
    UpDown7: TUpDown;
    UpDown8: TUpDown;
    Edit1: TEdit;
    Timer2: TTimer;
    CheckBox2: TCheckBox;
    procedure Button1Click(Sender: TObject);
    function login (phone, password : string) : string;
    function Pars(T_, ForS, _T: string): string;
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    function send_code (code : string) : string;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  start, start1: Ttime;
  login_exec, user_stop, start_thread : boolean;
  cookie: String;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  x:integer;

begin
  login_exec:=false;
  user_stop := false;
  start_thread := false;
  Timer1.Interval := 1000;
  if CheckBox1.Checked=true then x:=1 Else x:=0;
  if (LabeledEdit1.Text='') or (LabeledEdit2.Text='') Or (Memo2.Lines[0]='') Then
    begin
      showMessage('Введены не все данные');
      exit;
    end
      else
        begin
          start:=date+x + EncodeTime(strToInt(Edit_Hour.Text),strToInt(Edit_Minute.Text),strToInt(Edit_Sec.Text),strToInt(Edit_MSec.Text));   // Получение времени задания

          if start < Now then
            begin
              if MessageDlg('Время старта меньше текущего! Продолжить?', mtConfirmation, [mbYes, mbNo], 0) = mrNo then exit;
            end;
          Button1.Enabled:=false;
          Memo1.Lines.Add(TimeToStr(Now) + ' Старт программы.');
          Memo1.Lines.Add(TimeToStr(Now) + ' Ожидаем время логина.');
          timer1.Enabled:=True;

        end;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Timer1.Enabled:=false;
  Button1.Enabled:=true;
  user_stop := true;
end;

function TForm1.login (phone, password : string) : string;
var
  Puri_Auth, LoggingId, NET_SessionId, ConsumerIdStat, str, tmp: String;
  pulya: TStringList;
  idhttp1 : TIdHttp;
begin
  Result := 'Неизвестная ошибка.';

  If (Length (phone) <> 10) Or ( (Length (phone) = 10 ) And (Pos (' ', phone) >0) ) Then
    begin
      Result := 'Ошибка в номере телефона';
      exit;
    end;
  str := '+7 ' + phone[1] + phone[2] + phone[3] + ' ' + phone[4] + phone[5] + phone[6] + '-' +
            phone[7] + phone[8] + '-' + phone[9] + phone[10];
  phone := str;

  idhttp1 := TIdHttp.Create(nil);
  Idhttp1.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:19.0) Gecko/20100101 Firefox/19.0';
  Idhttp1.Request.AcceptLanguage := 'ru-RU,ru;q=0.8,en-US;q=0.5,en;q=0.3';
  Idhttp1.HandleRedirects := true;
  Idhttp1.AllowCookies := true;

  try
    Idhttp1.Get('http://........../');
  except
    tmp := IntToStr (IdHttp1.ResponseCode);
    If tmp[1] = '5' Then Result := 'Ошибка сервера';
    If tmp[1] = '4' Then Result := 'Ошибка клиента';
  end;

  Idhttp1.Request.Referer := 'http://........./';

  try
    Idhttp1.Get('http://......../');
  except
    tmp := IntToStr (IdHttp1.ResponseCode);
    If tmp[1] = '5' Then Result := 'Ошибка сервера';
    If tmp[1] = '4' Then Result := 'Ошибка клиента';
  end;

  str := Idhttp1.Response.RawHeaders.Text;
  LoggingId := Copy (str, pos('LoggingId=',str)+10, 36);

  Idhttp1.CookieManager.CookieCollection.Clear;
  Idhttp1.Request.CustomHeaders.Text := 'Cookie: LoggingId=' + LoggingId;

  try
  Idhttp1.Get('http://........./Security/Login');
  except
    tmp := IntToStr (IdHttp1.ResponseCode);
    If tmp[1] = '5' Then Result := 'Ошибка сервера';
    If tmp[1] = '4' Then Result := 'Ошибка клиента';
  end;

  pulya:= Tstringlist.Create;
  pulya.Add('LoginViewData.Login=' + phone);
  pulya.Add('LoginViewData.Password='+ LabeledEdit2.Text);
  Idhttp1.Request.Referer :='http://........../Security/Login';
  Idhttp1.HandleRedirects := false;

  try
    Idhttp1.Post('http://................../Security/Login',pulya);
  except
    tmp := IntToStr (IdHttp1.ResponseCode);
    If tmp[1] = '5' Then Result := 'Ошибка сервера';
    If tmp[1] = '4' Then Result := 'Ошибка клиента';
    if IdHttp1.ResponseCode = 302 then
      begin
        str := Idhttp1.Response.RawHeaders.Text;
        NET_SessionId := Pars('ASP.NET_SessionId=',str,';');
        Puri_Auth := Pars('Puri_Auth=',str,';');
        Idhttp1.CookieManager.CookieCollection.Clear;
        cookie := 'Cookie: ASP.NET_SessionId=' + NET_SessionId + '; LoggingId=' + LoggingId + '; Puri_Auth=' + Puri_Auth;
        Idhttp1.Request.CustomHeaders.Text := cookie;
        Idhttp1.Request.Referer :='/';

        try
          tmp := Idhttp1.Get('http://............/');
        except
          tmp := IntToStr (IdHttp1.ResponseCode);
          If tmp[1] = '5' Then Result := 'Ошибка сервера';
          If tmp[1] = '4' Then Result := 'Ошибка клиента';
        end;
        Pulya.Free;
        str := Idhttp1.Response.RawHeaders.Text;
        ConsumerIdStat := Pars('ConsumerIdStat=',str,';');
        cookie := cookie + '; ConsumerIdStat=' + ConsumerIdStat;
        Idhttp1.CookieManager.CookieCollection.Clear;
        Idhttp1.Request.CustomHeaders.Text := cookie;
        If Pos ('/Personal">Личный кабинет<', tmp) > 0 Then Result := 'Залогинились' Else Result := 'Ошибка авторизации';
        IdHttp1.Free;
      end;
  end;
end;


function TForm1.Pars(T_, ForS, _T: string): string;
var
  a, b: integer;
begin
  Result := '';
  if (T_ = '') or (ForS = '') or (_T = '') then
    Exit;
  a := Pos(T_, ForS);
  if a = 0 then
    Exit
  else
    a := a + Length(T_);
  ForS := Copy(ForS, a, Length(ForS) - a + 1);
  b := Pos(_T, ForS);
  if b > 0 then
    Result := Copy(ForS, 1, b - 1);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  res : string;
begin
  if (start-0.0016<=now) AND (login_exec=false) then
    begin
      if user_stop = true Then
        begin
          Button1.Enabled:=true;
          Memo1.Lines.Add(TimeToStr(Now) + ' Работа остановлена пользователем');
          exit;
        end;
      Timer1.Enabled := false;
      Memo1.Lines.Add(TimeToStr(Now) + ' Пытаемся залогиниться.');
      res := Login (LabeledEdit1.Text, LabeledEdit2.Text);
      If res = 'Залогинились' Then
        begin
          Memo1.Lines.Add(TimeToStr(Now) + ' ' + res + '.');
          login_exec := true;
          Timer1.Interval := 10;
          send01.Create(False);
          send02.Create(False);
          send03.Create(False);
          send04.Create(False);
          send05.Create(False);
          send06.Create(False);
          send07.Create(False);
          send08.Create(False);
          send09.Create(False);
          send010.Create(False);
          start1:=date + EncodeTime(strToInt(Edit_Hour1.Text),strToInt(Edit_Minute1.Text),strToInt(Edit_Sec1.Text),strToInt(Edit_MSec1.Text));   // Получение времени задания 2







          Timer1.Enabled := true;
        end
          Else
            begin
              Memo1.Lines.Add(TimeToStr(Now) + ' ' + res + '.');
              exit;
            end;
    end;
  IF (start<= now) AND (login_exec=true) Then
    begin
      Timer1.Enabled := false;
      start_thread := true;
      if checkbox2.Checked = true Then  Timer2.Enabled := true Else
        begin
          Memo1.Lines.Add(TimeToStr(Now) + ' Работа завершена.' );
          Button1.Enabled:=true;
        end;

    end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
var
  res: string;
begin
  if start1 <= now then
    begin
      Timer2.Enabled := false;
      res := send_code (Edit1.Text);
      Memo1.Lines.Add(res);
      Memo1.Lines.Add(TimeToStr(Now) + ' Работа завершена.' );
      Button1.Enabled:=true;
    end;
end;

function TForm1.send_code (code : string) : string;
var
  pulya : TStringList;
  idhttp1 : TIdHttp;
  str, tmp : string;
begin
  Result := ' -?';
  pulya := TStringList.Create;
  pulya.Add('ActivateViewData.OnpackCode=' + code);
  idhttp1 := TIdHttp.Create(nil);
  Idhttp1.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:19.0) Gecko/20100101 Firefox/19.0';
  Idhttp1.Request.AcceptLanguage := 'ru-RU,ru;q=0.8,en-US;q=0.5,en;q=0.3';
  Idhttp1.HandleRedirects := true;
  Idhttp1.AllowCookies := true;
  Idhttp1.Request.CustomHeaders.Text := cookie;
  try
    str := idhttp1.Post('http://............../Activate', pulya);
    tmp := Copy (Idhttp1.Response.RawHeaders.Text, Pos ('Date:', Idhttp1.Response.RawHeaders.Text), Pos ('GMT', Idhttp1.Response.RawHeaders.Text) - Pos ('Date:', Idhttp1.Response.RawHeaders.Text));
  Except
    tmp := IntToStr (idhttp1.ResponseCode);
    If tmp[1] = '5' Then Result := TimeToStr(Now) + ' Ошибка сервера';
    If tmp[1] = '4' Then Result := TimeToStr(Now) + ' Ошибка клиента';
  end;
  pulya.Free;
  Idhttp1.Free;
  If Pos ('Код принят!', str) >0 Then
  begin
    Result := TimeToStr(Now) + ' Код ' + code +  ' активирован ' + tmp;
  end;
  If Pos ('неверного формата', str) >0 Then Result := TimeToStr(Now) + ' Код ' + code +  ' -bad';
  If Pos ('был уже', str) >0 Then Result := TimeToStr(Now) + ' Код ' + code +  ' ранее';
  If Pos ('вы не можете ', str) >0 Then Result := TimeToStr(Now) + ' Код ' + code +  ' вы не можете';
end;



end.


send1:
Код:
unit send1;

interface

uses
  Classes, IdHttp;

type
  send01 = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
    procedure UpdateMemo2;
    procedure UpdateMemo1;
  end;
var
  n : integer;
  memo1_send, memo2_send : string;
implementation
uses
  SysUtils, Unit1;


procedure send01.Execute;
var
  code, str, tmp: string;
  http: TIdHttp;
  pulya : TStringList;

begin
  n := 0;
  try
    code := Form1.Memo2.Lines[n];
  finally

  end;
  If code = '' Then Exit;


  Http:= TIdHttp.Create(Nil);
  http.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:19.0) Gecko/20100101 Firefox/19.0';
  http.Request.AcceptLanguage := 'ru-RU,ru;q=0.8,en-US;q=0.5,en;q=0.3';
  http.HandleRedirects := true;
  http.AllowCookies := true;
  http.Request.CustomHeaders.Text := Unit1.cookie;
  //Http.Get('http://................./Activate');
  pulya:= Tstringlist.Create;
  pulya.Add ('ActivateViewData.OnpackCode=' + code);
  While Unit1.start_thread = false Do
    begin
      Sleep(10);
    end;

  try
    str := Http.Post('http://.............../Activate', pulya);
    tmp := Copy (http.Response.RawHeaders.Text, Pos ('Date:', http.Response.RawHeaders.Text), Pos ('GMT', http.Response.RawHeaders.Text) - Pos ('Date:', http.Response.RawHeaders.Text));
  except
    tmp := IntToStr (Http.ResponseCode);
    If tmp[1] = '5' Then memo1_send := TimeToStr(Now) + ' Ошибка сервера';
    If tmp[1] = '4' Then memo1_send := TimeToStr(Now) + ' Ошибка клиента';
  end;
  pulya.Free;
  Memo2_send := code + ' -?' ;
  If Pos ('принят!', str) >0 Then
  begin
    Memo2_send := Form1.Memo2.Lines[n] + ' -ok';
    memo1_send := TimeToStr(Now) + ' Код ' + code +  ' активирован ' + tmp;
  end;

  If Pos ('неверного формата', str) >0 Then Memo2_send := Form1.Memo2.Lines[n] + ' -bad';
  If Pos ('был уже', str) >0 Then memo1_send := TimeToStr(Now) + ' Код ' + code +  ' ранее';
  If Pos ('вы не можете', str) >0 Then memo1_send := TimeToStr(Now) + ' Код ' + code +  ' вы не можете';
  http.Free;
  Synchronize(UpdateMemo2);
  Synchronize(UpdateMemo1);
end;

procedure send01.UpdateMemo2;
begin
  Form1.Memo2.Lines[n] := Memo2_send;
end;


procedure send01.UpdateMemo1;
begin
  Form1.Memo1.Lines.Add (Memo1_send);
end;
end.

Я понимаю, что косяков много, но можно пока без указания на неправильность имен (с заглавной, или строчной буквы).
Сразу скажу - это моё хобби, а не работа. Так что корявого программиста, за которым нужно все будет переделывать, вы не увидите :)
 
Награды
7
В общем то, что я и предполагал. Все данные, которые каждый поток сам выцепляет из глобальных переменных, из мемо и т.п. можно передать ему в конструктор и вместо объявления десяти юнитов и десяти потоков иметь объявленный один поток в одном юните. Создать его 10 экземпляров. Т.е. например будет выглядеть это так:

Код:
TSend=class(TThread)
strict private
  FData:string;
strict protected
  property Data:string read FData;
public
  constructor Create(aCreateSuspended:Boolean; const aData:string);
end;

constructor TSend.Create(aCreateSuspended:Boolean; const aData:string);
begin
  inherited Create(aCreateSuspended);
  FData:=aData;
end;

и запуск.

Код:
for idxLine := 0 to Memo1.Lines.Count-1 do
  TSend.Create(Memo1.Lines[idxLine]);

вместо

Код:
send01.Create(...);
...
send10.Create(...);

То же самое cookie можно передавать аналогично.

Кстати, обрати внимание, потоки у тебя не разрушаются никем, поэтому имеет место утечка памяти. Ожидания выполнения потоков тоже нет.

Кроме того, у тебя из потока идёт обращение к элементам управления GUI. Это принципиально неверно. Правильно это когда поток выставляет свои свойства в секции public а код главного потока, присваивает и считывает из них какие-нибудь значения, например по таймеру.

Ещё момент. Имеет место обращения разных потоков к одним и тем-же объектам и переменным. Такие обращения всегда надо сериализовать через объекты синхронизации, например критические секции. Иначе два потока обратившиеся к одной и той-же переменной могут просто привести к непредсказуемым последствиям. В идеале-же вообще потоки не должны пользоваться совместно какими-либо ресурсами. Тогда отпадает необходимость и в сериализации.

//При помещении в Ваш пост исходного кода, обязательно обрамляйте его тегами [сode] и [/сode].
 

    Bell

    очки: 34
    Спасибо!
В общем то, что я и предполагал. Все данные, которые каждый поток сам выцепляет из глобальных переменных, из мемо и т.п. можно передать ему в конструктор и вместо объявления десяти юнитов и десяти потоков иметь объявленный один поток в одном юните. Создать его 10 экземпляров. Т.е. например будет выглядеть это так:

Код:
TSend=class(TThread)
strict private
  FData:string;
strict protected
  property Data:string read FData;
public
  constructor Create(aCreateSuspended:Boolean; const aData:string);
end;

constructor TSend.Create(aCreateSuspended:Boolean; const aData:string);
begin
  inherited Create(aCreateSuspended);
  FData:=aData;
end;

и запуск.

Код:
for idxLine := 0 to Memo1.Lines.Count-1 do
  TSend.Create(Memo1.Lines[idxLine]);

вместо

Код:
send01.Create(...);
...
send10.Create(...);

То же самое cookie можно передавать аналогично.

Кстати, обрати внимание, потоки у тебя не разрушаются никем, поэтому имеет место утечка памяти. Ожидания выполнения потоков тоже нет.

Кроме того, у тебя из потока идёт обращение к элементам управления GUI. Это принципиально неверно. Правильно это когда поток выставляет свои свойства в секции public а код главного потока, присваивает и считывает из них какие-нибудь значения, например по таймеру.

Ещё момент. Имеет место обращения разных потоков к одним и тем-же объектам и переменным. Такие обращения всегда надо сериализовать через объекты синхронизации, например критические секции. Иначе два потока обратившиеся к одной и той-же переменной могут просто привести к непредсказуемым последствиям. В идеале-же вообще потоки не должны пользоваться совместно какими-либо ресурсами. Тогда отпадает необходимость и в сериализации.

//При помещении в Ваш пост исходного кода, обязательно обрамляйте его тегами [сode] и [/сode].

Спасибо! Буду разбираться.
Вот нашел примеры с конструктором: http://www.delphisources.ru/pages/faq/faq_delphi_basics/Constructor.php.html
Это как раз то, что мне нужно? И еще вопрос по примеру вверху: Почему при запуске программы, 'Pink Lady' сначала фрукт, а потом яблоко!? То есть здесь создается 3 объекта, но сообщений выводится 4!
 
Награды
7
Вот нашел примеры с конструктором: http://www.delphisources.ru/pages/faq/faq_delphi_basics/Constructor.php.html
Это как раз то, что мне нужно?
В целом да. Хотя бы я порекомендовал что-нибудь другое, т.к. указанная статья написана довольно безграмотным языком, в некоторых местах смахивающих на машинный перевод. См. раздел "литература" здесь.
И еще вопрос по примеру вверху: Почему при запуске программы, 'Pink Lady' сначала фрукт, а потом яблоко!? То есть здесь создается 3 объекта, но сообщений выводится 4!
Из трех объектов два типа TFruit, а один типа TApple который в свою очередь является наследником от TFruit. Т.е. для любого TFruit проверка ... is TFuit будет возвращать True, но ... is TApple будет возвращать False. Для любого TApple проверка ... is TFruit будет возвращать True потому что TApple - наследник от TFruit, и ... is TApple будет тоже возвращать True потому что это очевидно.

Т.е. из шести попыток вывода сообщения выполнятся три первых и последнее.
 
Вот нашел примеры с конструктором: http://www.delphisources.ru/pages/faq/faq_delphi_basics/Constructor.php.html
Это как раз то, что мне нужно?
В целом да. Хотя бы я порекомендовал что-нибудь другое, т.к. указанная статья написана довольно безграмотным языком, в некоторых местах смахивающих на машинный перевод. См. раздел "литература" здесь.
И еще вопрос по примеру вверху: Почему при запуске программы, 'Pink Lady' сначала фрукт, а потом яблоко!? То есть здесь создается 3 объекта, но сообщений выводится 4!
Из трех объектов два типа TFruit, а один типа TApple который в свою очередь является наследником от TFruit. Т.е. для любого TFruit проверка ... is TFuit будет возвращать True, но ... is TApple будет возвращать False. Для любого TApple проверка ... is TFruit будет возвращать True потому что TApple - наследник от TFruit, и ... is TApple будет тоже возвращать True потому что это очевидно.

Т.е. из шести попыток вывода сообщения выполнятся три первых и последнее.

Ясно. А как вывести диаметр яблока? Мы же его, вроде задаем!?
 
Награды
7
Что-то вроде:
Код:
[FONT=Courier New][SIZE=2]if Apple[SIZE=2] i[/SIZE]s TApple then ShowMessage(Apple.Name   +'  - apple ' + IntToStr(Apple.Distance));
[/SIZE][/FONT]


Хотя поскольку Apple и так является переменной типа TApple, то подобная проверка (... is TApple) реально не нужна. Достаточно просто написать
Код:
ShowMessage(Apple[SIZE=2].Name +[SIZE=2] ' - apple ' + Int[SIZE=2]ToStr(Apple.Distance));[/SIZE][/SIZE][/SIZE]
 
Что-то вроде:
Код:
[FONT=Courier New][SIZE=2]if Apple[SIZE=2] i[/SIZE]s TApple then ShowMessage(Apple.Name   +'  - apple ' + IntToStr(Apple.Distance));
[/SIZE][/FONT]


Хотя поскольку Apple и так является переменной типа TApple, то подобная проверка (... is TApple) реально не нужна. Достаточно просто написать
Код:
ShowMessage(Apple[SIZE=2].Name +[SIZE=2] ' - apple ' + Int[SIZE=2]ToStr(Apple.Distance));[/SIZE][/SIZE][/SIZE]

Уж тогда вот так:
Код:
ShowMessage(Apple.Name + ' - apple ' + IntToStr(Apple.Diameter));
Только не получается... Ругаться начинает так: [Error] Unit1.pas(113): Undeclared identifier: 'IntToStr'
 

    Ender

    очки: 248
    За то что сообразил привести текст ошибки. Многие на это не способны. :)
Награды
7
Надо подключить SysUtils. IntToStr объявлена в SysUtils, ну или System.SysUtils если у тебя новые версии Delphi - XE и т.п.

Код:
uses
  ...
  SysUtils,
  ...;
 
Вот появилось время поковыряться и опять вопросы.
Пример програмки:
Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    ListBox1: TListBox;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);

  private
    { Private declarations }

  public

    { Public declarations }
  end;


var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
type
 TMyData = record
   X: integer;
   Y: integer;
   Str: string;
   end;

var
  MyData1, MyData2: TMyData;
begin
  MyData1.X := StrToInt (Edit1.Text);
  MyData1.Y := StrToInt (Edit2.Text);
  MyData1.Str := 'Тест.';
  Memo1.Lines.add ('Текущая позиция X: ' + IntToStr(MyData1.X));
  Memo1.Lines.add ('Текущая позиция Y: ' + IntToStr(MyData1.Y));
  Memo1.Lines.Add('Следующая позиция X: ' + IntToStr(MyData1.X+1));
  Memo1.Lines.Add (MyData1.Str);
  MyData1 := MyData2;
  Memo1.Lines.Add (MyData2.Str);
end;

end.

Програмка тестовая, для понимания работы с record.
Вопрос - как сделать функцию, чтобы в результате её работы получать обновленное значение MyData?
То есть я передаю функции MyData а она изменяет значение MyData.X (например увеличивает на 1).
По логике нужно написать так:
Код:
function test (a: TMyData): TMyData;
но я же создал свой тип данных и delphi ругается. Может в другое место нужно вставить описание TMyData?
 
но я же создал свой тип данных и delphi ругается. Может в другое место нужно вставить описание TMyData?
Может быть прочесть чего она там ругается?
Если я ставлю описание функции туда, где описана процедура нажатия кнопки, то ругается так:
[Error] Unit1.pas(20): Undeclared identifier: 'TMyData'
 
Сверху