[ Delphi / Pascal ] — начинающим: задаем вопросы (архивная - 2015)

mcflash · 9 Aug 2009

Люди кто нибудь знает Как написать на delphi7 код для отправки смс

mcflash · 9 Aug 2009

Люди кто нибудь знает Как написать на delphi7 код для отправки смс

ZdezBilYa · 9 Aug 2009

mcflash said:

Люди кто нибудь знает Как написать на delphi7 код для отправки смс
Click to expand...

можно через сайт оператора с вводом капчи, можно через e-mail-гейт (если у абонента подключен), можно через ICQ слать

Kuzya · 9 Aug 2009

Скажите пожалуйста кто-нибудь функцию замены подстроки в строке на Delphi 2009. Я знаю что в интернете полно исходников таких функций, но в 2009-ом точно должна быть своя встроенная.

ZdezBilYa · 9 Aug 2009

Kuzya said:

Скажите пожалуйста кто-нибудь функцию замены подстроки в строке на Delphi 2009. Я знаю что в интернете полно исходников таких функций, но в 2009-ом точно должна быть своя встроенная.
Click to expand...

Pos + Delete + Insert

mailbrush · 9 Aug 2009

Kuzya said:

Скажите пожалуйста кто-нибудь функцию замены подстроки в строке на Delphi 2009. Я знаю что в интернете полно исходников таких функций, но в 2009-ом точно должна быть своя встроенная.
Click to expand...

Да, есть встроенная - StringReplace();

ZdezBilYa, вчитайся в вопрос.

mailbrush · 13 Aug 2009

Надо написать генератор рандумной строки из даных символов. Я сделал это
Code:
function Rand(count,symbols: string): string;
var
i: integer;
begin
Randomize;
  for i:=1 to StrToInt(count) do
    begin
      result:=result+symbols[Random(Length(symbols))]);
      Application.ProcessMessages;
    end;
end;
Но трабла в том, что генерит он не совсем рандумно. Пример: http://img44.imageshack.us/img44/7493/11637706.png
Я специально поставил только цифры, чтобы было лучше видно.
Как решить это?
PS: Процедуру Randomize пробовал засовывать в OnCreate - не помогло.

=Zeus= · 13 Aug 2009

Вот простой примерчик, все работает на ура
Code:
procedure TForm1.Button1Click(Sender: TObject);
var s: string;
      i: byte;
begin
caption:='';
Randomize;
s:='abcd';
for i:=1 to 10 do
 caption:=caption+  s[Random(length(s))+1];
end;
Попробовал ваш пример у себя - тоже все нормально. незнаю, почему у вас такие результаты получились... Может он выполняеться по тайперу с интервалом 1 ?? Рандом ведь от времени зависит.
П.С. у вас в коде нужно +1 добавить в рандом. Без него длина строки разная каждый раз. Рандом ведь и 0 возвращяет, а в строке символа с индексом 0 нету.

МongBa† · 13 Aug 2009

mailbrush
Больше нагруз на систему но думаю должно сработать:

Code:

function Rand(count,symbols: string): string;
var
i,rnd: integer;
begin
Randomize;
  for i:=1 to StrToInt(count) do
    begin
      rnd:=(Random(Length(symbols))+1)*9;
      while rnd>Length(symbols) do rnd-Random(Length(symbols));
      result:=result+symbols[rnd];
      Application.ProcessMessages;
    end;
end;

Nullsleep · 13 Aug 2009

Code:

function Rand(const count: Integer; const symbols: string): string;
var
  i: Integer;
begin
  Result := '';
  Randomize;
  for i := 1 to count do
  begin
    Result := Result + symbols[Random(Length(symbols))+1];
    Application.ProcessMessages;
  end;
end;

это работает у меня нормально.
http://img406.imageshack.us/img406/2205/aga.png

=Zeus= · 13 Aug 2009

2 Nullsleep
Дык, это же то же самое, что я написал, только функция.

А вообще меня улыбнуло. Такая простая вещь на первый взгляд, но как ни странно за 3 года я ни разу не пользовался такой функцией =))
И еще. По-моему Application.ProcessMessages там никчему, функция итак быстро работает.

Seregakz · 14 Aug 2009

Как можноно с помощью wininet передать пост запросом бинарный файл на сервер??

dos999 · 14 Aug 2009

Посмотри тут http://www.rsdn.ru/article/inet/wininet.xml вроде норм расписано про функции.

Seregakz · 14 Aug 2009

dos999 said:

Посмотри тут http://www.rsdn.ru/article/inet/wininet.xml вроде норм расписано про функции.
Click to expand...

Да и ещё там с++((
я 0 в нём!
уже пробовал передавать текстовые файлы оони норм передаются, а вот если гиф картингу или rar архив но нефика(
приведине пример народ оч нуна

dos999 · 14 Aug 2009

вообще не приходит или приходит но кривой?
попробуй Content-Type изменить на
HttpSendRequest(hResourceHandle, 'Content-Type: application/vnd', 47, szData, lstrlen(szData));

Seregakz · 14 Aug 2009

dos999 said:

вообще не приходит или приходит но кривой?
попробуй Content-Type изменить на
HttpSendRequest(hResourceHandle, 'Content-Type: application/vnd', 47, szData, lstrlen(szData));
Click to expand...

да не приходит ибо отправляю таким методом, а этот метод ток тект отпрвляет) а бинарники никак:

PHP:

procedure send(file:String); var szBuf: array [0..6000000] of Char; begin ZeroMemory(@szBuf, SizeOf(szBuf)); lstrcpy(szBuf, PChar('file=')); lstrcat(szBuf, ((GetFileData(PChar(file))))); SendPOSTData(Host, Path, szBuf); end;

WereWolfV · 14 Aug 2009

Всем привет. Пробую писать свой HTTP клиент на сокетах. Тестить решил на mail.ru, страницу принимает, POST запрос отправляет. Но на попытку авторизации выдает страницу 302. Снифал все со своего браузера (Opera 9.64) заголовки запросов списал с него. POST запросы у программы и браузера идентичные, но через браузер авторизируется, а через прогу получаю страницу 302.
Алгоритм тестирования: отправляю GET запрос на главную страницу mail.ru, получаю куки, вставляю эти куки в POST запрос с логином и паролем, отсылаю его. (куки полученые после GET вставляю вручную через TEdit)
Помогите, кто знает из-за чего не идет авторизация.
Вот код:

Code:

type
  THTTPClientForm = class(TForm)
    Memo1: TMemo;
    Label1: TLabel;
    URL: TLabel;
    EdURL: TEdit;
    Button1: TButton;
    Edit3: TEdit;
    Label4: TLabel;
    Memo2: TMemo;
    EditMpopl: TEdit;
    EditMrcu: TEdit;
    procedure Button1Click(Sender: TObject);
    Function GetWEBpage(addr:string; Method:integer):TStringList;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure EdURLKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  HTTPClientForm: THTTPClientForm;
  SendBuff:string;
  POST:string;

implementation

uses unit2;

{$R *.dfm}

procedure THTTPClientForm.Button1Click(Sender: TObject);
begin
Memo1.Lines.Assign(GetWebPage(edURL.text, StrToInt(Edit3.Text)));
end;

Function THTTPClientForm.GetWEBPage;
var
  localaddr : sockaddr_in;
  iMode, iSize:integer;
  rfds: TFDSET;
  Buff: array [0..1024] of char;
  stClient:TSocket;
  testingserver, servername, portname:string;
  timeout:TTimeVal;
begin

  Result:=TStringList.Create;

  stClient:=socket(AF_INET, SOCK_STREAM, 0);
  if stClient=INVALID_SOCKET then
    begin
      messageBox(0, 'Ошибка инициализации сокета', 'Error', MB_OK);
      exit;
    end;

      ServerName:='mail.ru';
      PortName:='80';

localaddr.sin_addr:=LookUpName(servername);
localaddr.sin_family:=AF_INET;
localaddr.sin_port:=htons(StrToIntDef(portname, 80));

if connect(stClient, @localaddr, sizeof(localaddr))<>0 then
  begin
    messageBox(0, 'Ошибка соединения', 'Error', MB_OK);
    exit;
  end;

  SendBuff:='';

  if method=1 then
     SendBuff:=
    'GET / HTTP/1.1'#13+
    'User-Agent: Opera/9.64 (Windows NT 5.1; U; ru) Presto/2.1.1'#13+
    'Host: www.mail.ru'#13+
    'Accept: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1'#13+
    'Accept-Language: ru-RU,ru;q=0.9,en;q=0.8'#13+
    'Accept-Charset: iso-8859-1, utf-8, utf-16, *;q=0.1'#13+
    'Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0'#13+
    'If-Modified-Since: Fri, 14 Aug 2009 11:18:57 GMT'#13+
    'Connection: Keep-Alive, TE'#13+
    'TE: deflate, gzip, chunked, identity, trailers'#13#13;

  if method=2 then
    begin
      POST:='Login=UserLogin+&Domain=mail.ru&Password=UserPassword';
      SendBuff:=
      'POST /cgi-bin/auth HTTP/1.1'#13+
      'User-Agent: Opera/9.64 (Windows NT 5.1; U; ru) Presto/2.1.1'#13+
      'Host: win.mail.ru'#13+
      'Accept: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1'#13+
      'Accept-Language: ru-RU,ru;q=0.9,en;q=0.8'#13+
      'Accept-Charset: iso-8859-1, utf-8, utf-16, *;q=0.1'#13+
      'Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0'#13+
      'Referer: http://www.mail.ru/'#13+
      'Cookie: Mpopl='+EditMpopl.Text+'; mrcu='+EditMrcu.Text+';'#13+
      'Cookie2: $Version=1'#13+
      'Connection: Keep-Alive, TE'#13+
      'TE: deflate, gzip, chunked, identity, trailers'#13+
      'Content-Length: '+IntToStr(Length(POST))+#13+
      'Content-Type: application/x-www-form-urlencoded'#13#13+POST;
    end;

    Memo2.Lines.Clear;
    Memo2.Lines.Add(SendBuff);
    SendStr(stClient,SendBuff);

iMode:=1;
setsockopt(stClient, IPPROTO_TCP, TCP_NODELAY, @iMode, sizeof(integer));

  while true do
    begin
      FD_ZERO(rfds);
      FD_SET(stClient, rfds);

      timeout.tv_sec:=10;
      if (select(0, @rfds, nil, nil, @timeout)<=0) then
        exit;

      if (FD_ISSET(stClient, rfds)) then
        begin
          iSize:=recv(stClient, buff, sizeof(buff), 0);
          if (iSize<1) then
           break;
           Result.Add(String(buff));
        end;
    end;
      CloseSocket(stClient);
end;

procedure THTTPClientForm.FormCreate(Sender: TObject);
var SockInit:TWSADATA;
begin
WSAStartUp(makeword(2,0), SockInit)
end;

login999 · 14 Aug 2009

WereWolfV said:

Всем привет. Пробую писать свой HTTP клиент на сокетах. Тестить решил на mail.ru, страницу принимает, POST запрос отправляет. Но на попытку авторизации выдает страницу 302. Снифал все со своего браузера (Opera 9.64) заголовки запросов списал с него. POST запросы у программы и браузера идентичные, но через браузер авторизируется, а через прогу получаю страницу 302.
Алгоритм тестирования: отправляю GET запрос на главную страницу mail.ru, получаю куки, вставляю эти куки в POST запрос с логином и паролем, отсылаю его. (куки полученые после GET вставляю вручную через TEdit)
Помогите, кто знает из-за чего не идет авторизация.
Вот код:

Code:

type
  THTTPClientForm = class(TForm)
    Memo1: TMemo;
    Label1: TLabel;
    URL: TLabel;
    EdURL: TEdit;
    Button1: TButton;
    Edit3: TEdit;
    Label4: TLabel;
    Memo2: TMemo;
    EditMpopl: TEdit;
    EditMrcu: TEdit;
    procedure Button1Click(Sender: TObject);
    Function GetWEBpage(addr:string; Method:integer):TStringList;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure EdURLKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  HTTPClientForm: THTTPClientForm;
  SendBuff:string;
  POST:string;

implementation

uses unit2;

{$R *.dfm}

procedure THTTPClientForm.Button1Click(Sender: TObject);
begin
Memo1.Lines.Assign(GetWebPage(edURL.text, StrToInt(Edit3.Text)));
end;

Function THTTPClientForm.GetWEBPage;
var
  localaddr : sockaddr_in;
  iMode, iSize:integer;
  rfds: TFDSET;
  Buff: array [0..1024] of char;
  stClient:TSocket;
  testingserver, servername, portname:string;
  timeout:TTimeVal;
begin

  Result:=TStringList.Create;

  stClient:=socket(AF_INET, SOCK_STREAM, 0);
  if stClient=INVALID_SOCKET then
    begin
      messageBox(0, 'Ошибка инициализации сокета', 'Error', MB_OK);
      exit;
    end;

      ServerName:='mail.ru';
      PortName:='80';

localaddr.sin_addr:=LookUpName(servername);
localaddr.sin_family:=AF_INET;
localaddr.sin_port:=htons(StrToIntDef(portname, 80));

if connect(stClient, @localaddr, sizeof(localaddr))<>0 then
  begin
    messageBox(0, 'Ошибка соединения', 'Error', MB_OK);
    exit;
  end;

  SendBuff:='';

  if method=1 then
     SendBuff:=
    'GET / HTTP/1.1'#13+
    'User-Agent: Opera/9.64 (Windows NT 5.1; U; ru) Presto/2.1.1'#13+
    'Host: www.mail.ru'#13+
    'Accept: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1'#13+
    'Accept-Language: ru-RU,ru;q=0.9,en;q=0.8'#13+
    'Accept-Charset: iso-8859-1, utf-8, utf-16, *;q=0.1'#13+
    'Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0'#13+
    'If-Modified-Since: Fri, 14 Aug 2009 11:18:57 GMT'#13+
    'Connection: Keep-Alive, TE'#13+
    'TE: deflate, gzip, chunked, identity, trailers'#13#13;

  if method=2 then
    begin
      POST:='Login=UserLogin+&Domain=mail.ru&Password=UserPassword';
      SendBuff:=
      'POST /cgi-bin/auth HTTP/1.1'#13+
      'User-Agent: Opera/9.64 (Windows NT 5.1; U; ru) Presto/2.1.1'#13+
      'Host: win.mail.ru'#13+
      'Accept: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1'#13+
      'Accept-Language: ru-RU,ru;q=0.9,en;q=0.8'#13+
      'Accept-Charset: iso-8859-1, utf-8, utf-16, *;q=0.1'#13+
      'Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0'#13+
      'Referer: http://www.mail.ru/'#13+
      'Cookie: Mpopl='+EditMpopl.Text+'; mrcu='+EditMrcu.Text+';'#13+
      'Cookie2: $Version=1'#13+
      'Connection: Keep-Alive, TE'#13+
      'TE: deflate, gzip, chunked, identity, trailers'#13+
      'Content-Length: '+IntToStr(Length(POST))+#13+
      'Content-Type: application/x-www-form-urlencoded'#13#13+POST;
    end;

    Memo2.Lines.Clear;
    Memo2.Lines.Add(SendBuff);
    SendStr(stClient,SendBuff);

iMode:=1;
setsockopt(stClient, IPPROTO_TCP, TCP_NODELAY, @iMode, sizeof(integer));

  while true do
    begin
      FD_ZERO(rfds);
      FD_SET(stClient, rfds);

      timeout.tv_sec:=10;
      if (select(0, @rfds, nil, nil, @timeout)<=0) then
        exit;

      if (FD_ISSET(stClient, rfds)) then
        begin
          iSize:=recv(stClient, buff, sizeof(buff), 0);
          if (iSize<1) then
           break;
           Result.Add(String(buff));
        end;
    end;
      CloseSocket(stClient);
end;

procedure THTTPClientForm.FormCreate(Sender: TObject);
var SockInit:TWSADATA;
begin
WSAStartUp(makeword(2,0), SockInit)
end;

Click to expand...

Хз как там в дельфях, но 302 это редирект, маилру после авторизации редиректит... Так что походу все ок

WereWolfV · 14 Aug 2009

забыл написать, редиректит на http://win.mail.ru/cgi-bin/auth а при правильной авторизации должно на что-то подобное http://win.mail.ru/cgi-bin/checkcookie?id=4f06025a64445b73190502199a1d00071c0c014f6a5d5e465e07070802051e0b03031e4e5c4a54475e5b5341145c555e551f4243
и после на страницу пользователя.

sadfeel · 14 Aug 2009

Как найти вложение текста в строке не учитывая регистр..? Делал через Pos но там регистр учитывается. помогите плиз. Работаю в дeлфи

[ Delphi / Pascal ] — начинающим: задаем вопросы (архивная - 2015)

mcflash New Member

mcflash New Member

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

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

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

mailbrush Well-Known Member

mailbrush Well-Known Member

=Zeus= Member

МongBa† Member

Nullsleep Member

=Zeus= Member

Seregakz New Member

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

Seregakz New Member

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

Seregakz New Member

WereWolfV New Member

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

WereWolfV New Member

sadfeel Member

Useful Searches

[ Delphi / Pascal ] — начинающим: задаем вопросы (архивная - 2015)

mcflash New Member

mcflash New Member

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

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

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

mailbrush Well-Known Member

mailbrush Well-Known Member

=Zeus= Member

МongBa† Member

Nullsleep Member

=Zeus= Member

Seregakz New Member

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

Seregakz New Member

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

Seregakz New Member

WereWolfV New Member

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

WereWolfV New Member

sadfeel Member