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

[Nick_Rimer]

суть такова: нужно программно открыть ярлык нажатием на кнопочку. Теперь подробнее:

Путь к ярлыку: C:\Program Files\Borland\Delphi7\Projects\A
Содержимое: файл A.rc, файл brcc32.exe и файл brcc32.exe.lnk

В ярлыке все нужное уже сделано. При его запуске вручную двумя кликами файл A.rc компилируется, и получается ресурс A.res

То же самое необходимо теперь провернуть при помощи Delphi. Сделать такую строку:

ShellExecute(Handle, 'open', 'brcc32.exe', nil, s, SW_RESTORE);

можно. Работает, но смысл? Его нет..

А такая строка:

ShellExecute(Handle, 'open', 'brcc32.exe.lnk', nil, s, SW_RESTORE);

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

При попытке:

case ShellExecute(Handle, 'open', 'brcc32.exe.lnk', nil, s, SW_RESTORE) of
2: ShowMessage('wrong');
end;

вылезает то самое сообщение 'wrong'..

кстати, s - это путь к папке типа PAnsiChar

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

[t04]

дабавь в раздел uses
uses
ShellAPI;
юзай так
ShellExecute(0, 'open' ,PChar(cmd), nil, nil, SW_SHOWNORMAL);
где cmd это имя файла который надо открыть.

[Nick_Rimer]

для t04:

ну и что ты мне написал?.. я и так знаю, как юзается ShellExecute (я же это вполне подробно описал), и что нужно подкдлючить в uses. Программа ошибок не выдает, только вот brcc32.exe запустить я могу, а brcc32.exe.lnk - нет, а НАДО!!!

[SNAIPER ShoT]

Глупый вопрос задаю... Но как сделать на делфи лоадер библиотеке dll ??
Напишите код пожайлуста =)

[_empty]

создай новый проект , допиши в uses ShellApi

и вставь строчку в код -

ShellExecute(0,'open',PCHAR(cmd),nil,nil,SW_SHOWNO RMAL);


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

[_empty]

Глупый вопрос задаю... Но как сделать на делфи лоадер библиотеке dll ??
Напишите код пожайлуста =)


создай новый проект , допиши в uses ShellApi

и вставь строчку в код -

ShellExecute(0,'open',PCHAR(cmd),nil,nil,SW_SHOWNO RMAL);

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

[BlackSun]

Глупый вопрос задаю... Но как сделать на делфи лоадер библиотеке dll ??
Напишите код пожайлуста =)
hDll := LoadLibrary('you_dll.dll');

-----

ShellExecute(Handle, 'open', 'brcc32.exe.lnk', nil, s, SW_RESTORE);
ShellExecute(Handle, 'open', PChar(S + 'brcc32.exe.lnk'), nil, s, SW_RESTORE);

[Nick_Rimer]

что-то ничего не выходит.. пишу так:

s:=PChar('C:\Program Files\Borland\Delphi7\Projects\A');
case
ShellExecute(Handle, 'open', PChar(s+'brcc32.exe.lnk'), nil, s, SW_RESTORE) of
2: ShowMessage('wrong');
end;

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

[Попрошайка]

var
S: PAnsiChar;
begin
S := PChar ('C:\Program Files\Borland\Delphi7\Projects\A');
case ShellExecute(Handle, 'open', PChar (S+'\brcc32.exe.lnk'), nil, s, SW_RESTORE) of
2: ShowMessage('wrong');
end;

BackSlash поставь. Так должно работать. По крайней мере у меня всё работает.

[0verbreaK]

var
S: PAnsiChar;
begin
S := PChar ('C:\Program Files\Borland\Delphi7\Projects\A');
case ShellExecute(Handle, 'open', PChar (S+'\brcc32.exe.lnk'), nil, s, SW_RESTORE) of
2: ShowMessage('wrong');
end;

BackSlash поставь. Так должно работать. По крайней мере у меня всё работает.

Смысл тогда преобразование делать если тип PAnsiChar

S: PAnsiChar;
begin
S := 'C:\Program Files\Borland\Delphi7\Projects\A';

[Nick_Rimer]

проблема зашла в такой край:
ярлыки на всякую муть - открывает..
ярлыки на любой экзешник - хрен!

что бы это значило?!?!

[Pir4tt]

Хэндл в nil ставь для exe'шников ;) :
ShellExecute(0, nil, 'EXE.lnk', nil, nil, SW_SHOWNORMAL);

[Nick_Rimer]

для Pir4tt:

СПАСИБО!!! ну, наконец-то вот так заработало:

ShellExecute(Handle, nil, PChar('a.lnk'), nil, s, SW_RESTORE)

УРА!!! :))

[AHTOLLlKA]

ктонить может подкинуть сорец сокс проксика... м-м-м ??
найти не могу везде тока http

[0verbreaK]

ктонить может подкинуть сорец сокс проксика... м-м-м ??
найти не могу везде тока http

Исходный код программы FreeCap
http://www.freecap.ru/files/freecap_3.18-src.zip

[AHTOLLlKA]

Исходный код программы FreeCap
http://www.freecap.ru/files/freecap_3.18-src.zip
типо легких путей не ищем чтоле ... ))

[Попрошайка]

Смысл тогда преобразование делать если тип PAnsiChar

S: PAnsiChar;
begin
S := 'C:\Program Files\Borland\Delphi7\Projects\A';


А я его и не предлогал. Код автора я почти не менял.
:D

[SNAIPER ShoT]

Аааа вот ещё вопросик: как зделать что бы на кнопочку нажимаешь ну на любую батон как поставиш а он открывает любой Ie и заход на этот сайт??

[0verbreaK]

типо легких путей не ищем чтоле ... ))

Что не нравится. Ты попросил сокс тебе дали сокс. Че еще?

[0verbreaK]

Аааа вот ещё вопросик: как зделать что бы на кнопочку нажимаешь ну на любую батон как поставиш а он открывает любой Ie и заход на этот сайт??

ShellExecute - ранее обсуждали передестни страницу.


uses ShellAPI;

ShellExecute(Handle, 'open', 'forum.antichat.ru', NIL, NIL, SW_SHOW);

[AHTOLLlKA]

Что не нравится. Ты попросил сокс тебе дали сокс. Че еще?
собствена если ты не заметил, я просил сокс прокси сервер..
а ты мне дал кучу всего ищи копай..
сорцы фрикапа у меня есть...
ты думаешь если я сам написать не могу это..
то по чему думаешь что из груды всякого хлама я смогу это выдернуть Оо

[0verbreaK]

Пожалуйста

SOCKS5
freecap_3.18-src\src\freecap\Socks5Proxy.pas
SOCKS4
freecap_3.18-src\src\freecap\Socks4Proxy.pas

Там все методы организованы

[SNAIPER ShoT]

ShellExecute - ранее обсуждали передестни страницу.


uses ShellAPI;

ShellExecute(Handle, 'open', 'forum.antichat.ru', NIL, NIL, SW_SHOW);

Спс.. Ну с dll'кой не получается... Пишит типо не знает такой код :confused: ! И надо что так что бы открывалась типо на проге кнопка лоад на неё нажимаеш и прога запускает тот длл который с ней в одной папке.. Например:
1.exe и 1.dll , а вот если у длл будет другое имя то exe будет ругатся типо dll not found. Вот такой код скажите плз :)

[0verbreaK]

И надо что так что бы открывалась типо на проге кнопка лоад на неё нажимаеш и прога запускает тот длл который с ней в одной папке.. Например:

Надо знать, что экспортировать из библиотеки dll, то есть какие функции экспортные.



// Есть экспортная функция, которая заранее известна и находится в dll
// вот её прототип
f: function (p: PChar; b: Boolean): Boolean;

// Вот эта функция осуществляет загрузку dll библиотеки
// в адресное пространство вашей программы
procedure Call(DllName, ProcName: PChar);
var
hModule: THandle;
P: Pointer;
begin
f := NIL;
hModule := LoadLibrary(DllName);
if hModule <> 0 then p := GetProcAddress(hModule, ProcName);
if p <> NIL then f('ЗАРАНЕЕ_ИЗВЕСТНАЯ_ЭКСПОР� �ИРУЕМАЯ_ФУНКЦИЯ', false);
end;


В итоге получается следующее


var
Form1: TForm1;
// Есть экспортная функция, которая заранее известна и находится в dll
// вот её прототип
f: function (p: PChar; b: Boolean): Boolean;
implementation

{$R *.dfm}


// Вот эта функция осуществляет загрузку dll библиотеки
// в адресное пространство вашей программы
procedure Call(DllName, ProcName: PChar);
var
hModule: THandle;
P: Pointer;
begin
f := NIL;
hModule := LoadLibrary(DllName);
if hModule <> 0 then p := GetProcAddress(hModule, ProcName);
if p <> NIL then f('ЗАРАНЕЕ_ИЗВЕСТНАЯ_ЭКСПОР� �ИРУЕМАЯ_ФУНКЦИЯ', false);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
Call('1.dll', 'ЗАРАНЕЕ_ИЗВЕСТНАЯ_ЭКСПОРТ� �РУЕМАЯ_ФУНКЦИЯ');
end;

[krypt3r]

Снайпер, ты как-то мысли коряво свои излагаешь.
Ну с dll'кой не получается...
Это ты шеллэкзекутом длл открываешь? о_О Напиши обработчик нажатия на кнопку, в начале кода заюзай LoadLibrary, в конце FreeLibrary, если либа тебе не нужна. Кстати, хочу посоветовать заглянуть в документацию Delphi, там написано, как юзать динамическую загрузку библиотек

[0verbreaK]

Горазда проще работать с библиотекой вот так:


var
Form1: TForm1;
// прототип вызываемой функции
function func1(p:PChar):Boolean;stdcall; external '1.dll';
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
// вызываем
func1('ЗАРАНЕЕ_ИЗВЕСТНАЯ_ЭКСП� �РТИРУЕМАЯ_ФУНКЦИЯ');
end;

[SNAIPER ShoT]

Горазда проще работать с библиотекой вот так:


var
Form1: TForm1;
// прототип вызываемой функции
function func1(p:PChar):Boolean;stdcall; external '1.dll';
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
// вызываем
func1('ЗАРАНЕЕ_ИЗВЕСТНАЯ_ЭКСП� �РТИРУЕМАЯ_ФУНКЦИЯ');
end;


Вот такой принцип нужен.. -->Link<-- (http://dl.dump.ru/file_download/666471)

[0verbreaK]

Вот такой принцип нужен.. -->Link<-- (http://dl.dump.ru/file_download/666471)

Так и есть, объясни лучше, dll твоя или чужая?

[SNAIPER ShoT]

чужая...
и когда запускаю уже прогу она пишет всякую хню и закрывается. =(

[Попрошайка]

Аааа вот ещё вопросик: как зделать что бы на кнопочку нажимаешь ну на любую батон как поставиш а он открывает любой Ie и заход на этот сайт??

в Uses добавь ShellAPI , а

в обработчик события

begin
ShellExecute (Handle, 'OPEN',PChar ('www.ya.ru'), nil, nil, SW_SHOWNORMAL);
end;

И будет тебе счастье.

[0verbreaK]

чужая...
и когда запускаю уже прогу она пишет всякую хню и закрывается. =(

Так ты должен знать, что экспортировать из библиотеки dll. Что конкретно надо сделать? Что бы твоя программа вызвали некоторую функцию из библы, правильно? что за dll'ка.

[zl0y]

Для *.exe файлов лучше WinExec('1.exe',SW_SHOW);

[SNAIPER ShoT]

эта dll'ka просто должна влезть в другой процесс. Тоесть когда я нажимаю на лоад мой exe должен прятатся в Древо процессов... Вот а dll'ka просто должна загружатся вся в процес hl.exe :D мож кто знает такой.

[SNAIPER ShoT]

Для *.exe файлов лучше WinExec('1.exe',SW_SHOW);

А по подробнее мона? :)

[0verbreaK]

эта dll'ka просто должна влезть в другой процесс. Тоесть когда я нажимаю на лоад мой exe должен прятатся в Древо процессов... Вот а dll'ka просто должна загружатся вся в процес hl.exe :D мож кто знает такой.

Перехват API функций.

http://www.wasm.ru/article.php?article=apihook_1
http://www.wasm.ru/article.php?article=apihook_2
http://www.wasm.ru/article.php?article=apihook_3

ЗЫ, мне кажется это не для новичков.

[Nightmarе]

Подскажите 2 команды как мне зашифровать бинарный (.exe) файл, а так-же расшифровать его потом к исходному виду???
Вот например алгоритм шифрования текста:
memo.text:=code(memo.text);
Вот дешифрование:
memo.text:=decode(memo.text);

А можно ли тоже самое проделать с бинарным файлом???

Пробовал через TMemoryStream, File и т.д... Но как там считать текст, и уж тем более куда-то записать ХЗ...
Очень желательно подробный готовый пример.

[z01b]

Подскажите 2 команды как мне зашифровать бинарный (.exe) файл, а так-же расшифровать его потом к исходному виду???
Вот например алгоритм шифрования текста:
memo.text:=code(memo.text);
Вот дешифрование:
memo.text:=decode(memo.text);

А можно ли тоже самое проделать с бинарным файлом???

Пробовал через TMemoryStream, File и т.д... Но как там считать текст, и уж тем более куда-то записать ХЗ...
Очень желательно подробный готовый пример.

На винапи в данном случае я думаю будет очень легко.

Читаем файл в массив байтов через ReadFile(), потом шифруем побайтово после чего записываем массив в файл через WriteFile :)

[rankor777]

всем прив! вопрос такой: пишу прогу, для нее необходим юнит Ariphm.dcu, в комплекте с Борланд Делфи7 он не идет, гугл не помогает. подскажите плз, где его взять?
заранее спс )

[Dober'man]

Nightmarе
Assembler. Простейший алгоритм шифрования строк (http://forum.antichat.ru/thread69514.html)
Просто всавь его в процедуру...
Примерно так:

procedure code; stdcall;
var bufsize: DWORD;
buffer: byte;
asm
pushad
mov ecx, bufsize
mov esi, 0

L1:
xor buffer[esi], KEY
inc esi

loop L1
popad
ret
......................
end;

[Nightmarе]

Ага спс, а дальше всего то АСМ выучить и только...
Я просил рабочий код, а это я никогда в рабочее состояние не приведу.
У меня уже есть свой готовый алгоритм шифрования с открытым ключём, обычный текст шифрует замечательно, а вот как с бинарным кодом быть...

[W!z@rD]

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Шифрование исполняемого файла

В данном примере реализована процедура шифрования и расшифрования
одной только процедуры "вывода сообщения".Процедура изночально
не зашифровано ,что ни есть хорошо.Для того что бы процедура была
при запуске программы уже зашифрована надо написать внешнюю программку,
которая ба сканировала ехе-шник и находила определенные метки
(начальную и конечную) и шифровала бы всё между ними.Таким образом
вы получите готовый ехе-шник с уже зашифрованой(зашифрованым� �)процедурой.

Для того чтоб некоторым умным людям (crackers)жить было не легко,
после расшифровки и выполнения процедуры можно её опять зашифровать.

Более потробную информацию читайте в статье на «Королевства Delphi»
http://delphi.vitpc.com/mastering/safe/safe.htm

Там же читайте Открытый проект "Анти крэковые мучения"
http://delphi.vitpc.com/mastering/safe/index.htm

Зависимости: Windows, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms,Dialogs, StdCtrls;
Автор: DDA, Vologda
Copyright: «Королевства Delphi» Защита от несанкционированного
использования программ, написанных на Delphi
Дата: 3 марта 2004 г.
************************************************** *** }

unit Unit1;

interface

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

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

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure metka1;
//Начальная метка - нужна что бы находить потом в exe файле эти символы и знать
//откуда начинать шифровать
//Здесь метка представляет из себя десятичные числа от 0 до 256 через запятые
//Если метка 50,60,70,80,90 то это соответствует символам 2<FPZ
//Кстати, такого кол-во символов в метке может быть мало и лучше использовать больше
//Т.к если программа большая то такие последовательности могут встретиться не один раз
begin
asm
DB 50,60,70,80,90 //2<FPZ это метка начальная
end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
beep;
ShowMessage('Период использования программы истёк!');
end;

procedure metka2;
//Конечная метка - нужна чтобы знать до куда нужно шифровать в файле и
//докуда расшифровывать в памяти
begin
asm
DB 68,68,67,45,61 //DDA-= это метка конечная
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
//Процедура Расшифрования(В даном примере и зашифрования)
var
ptrAddr: Pointer; {для Адреса процедуры вывода сообщения}
dwOldProtect: DWORD;
begin
ptrAddr := @TForm1.Button1Click; //Получаем адрес процедуры вывода сообщения
VirtualProtect(@TForm1.Button1Click, 2048, PAGE_READWRITE, @dwOldProtect);
//2048 это размер в байтах с которыми можно работать(по моему)
//Если процедура большая то нужно подбирать соответствующий размер
while ptrAddr <> @metka2 do
//шифрование(слабое) выполняем пока не дойдем то конечной метки
begin
Byte(ptrAddr^) := Byte(ptrAddr^) xor $41;
//каждый байт в памяти ксорится с кодом 65'A'(к примеру)
//Используйте более надёжные алгоритмы шифрования
inc(Integer(ptrAddr));
end;

exit; //нужно так сделать что б компилятор включил эти процедуры
metka1; //в код,т.к Delphi не вставляет в результирующий код процедуры,
metka2; //которые никогда не используются
end;

//Такое шифрование взято для примера и не рекомендуется для использования серьёзной защиты
//Также рекомендуется использовать и проверочную контрольную сумму для проверки
//целостности кода программы.
//Теперь осталось только сделать отдельную программу которая искала бы
//в этом exe файле начальную и конечную метки и шифровало бы всё между ними
//Но для демонстрации можно посмотреть результат и сейчас
//Запустите программу и нажмите на кнопку 1 -Должно вывестись сообщение и звук.сигнал
//А если нажать на кнопку 2 - то прцедура нажатия на кнопку 1 зашифруется
//И если после этого нажать на кнопку 1 -то должно произойти что-то не предсказуемое
//т.к процедура зашифрованна и что-то нормального вы не увидите.

//Источник информации: CopyRight «Королевства Delphi»
//"Защита от несанкционированного использования программ, написанных на Delphi"

end.


(c) DelphiWorld

[SNAIPER ShoT]

А мне так с длл и не кто не поможет ? :(

[Dr.Bodja]

Ребята помогите пожалуйста. Суть задачи, нужно из Label.Caption сохранить данные в файл, это у меня получилось быстро, опыт работы с паскалем имею, но мне хочется, чтобы путь не был сразу прописан, и чтобы его не вводить в строку edit, а чтобы была кнопка "Обзор" после нажатия которой, появлялось окошко windows где можно было бы выбрать путь, куда сохранять файл. Зарание спасибо.

[qPhoenix]

2 Dr.Bodja
procedure TForm1.BitBtn1Click(Sender: TObject);
var Fil:TextFile;
SaveDialog1:TSaveDialog;
begin
SaveDialog1:=TSaveDialog.Create(nil);
if SaveDialog1.Execute then
begin
assignfile(Fil,SaveDialog1.FileName);
//...//
end;
SaveDialog1.Free;
end;

[Dr.Bodja]

Спасибо большое!

[0verbreaK]

А мне так с длл и не кто не поможет ? :(

Ты получается хочешь инжектиться в hl.exe, проще говоря в халяву, не объясняешь толком что именно нужно и требуешь результата.

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

[A2GIL]

Ага спс, а дальше всего то АСМ выучить и только...
Я просил рабочий код, а это я никогда в рабочее состояние не приведу.
У меня уже есть свой готовый алгоритм шифрования с открытым ключём, обычный текст шифрует замечательно, а вот как с бинарным кодом быть...

+W!z@rD

Еще вот простенький модуль (без асм вставок) для щифрования исполняемых файлов:

Скачать (Crypting) (http://www.aladin88.jino-net.ru/Crypting.rar)

Пользоваться так, к примеру:

var
procedure TForm1.Button1Click(Sender: TObject);
var
key:TWordTriple;
begin
key[0]:=1; key[1]:=2; key[2]:=3;
FileEncrypt('C:\123.exe','C:\new123.exe',key);

{FileDecrypt('C:\new123.exe','C:\new123.exe',key,t rue);}
end;

[hoty]

Стояла у меня одна ОС:
смена языка (русский/английский) производилась нажатием shift & alt.
в Паскале 7.0 нужно было нажимать shift & ctrl.

Сейчас стоит таже ОС (более новая):
смена языка производится нажатием shift & ctrl (изначально в системе так).
но в Паскале НИКАК не могу изменить язык.

Подскажите, какими ЕЩЕ клавишами (мне срочно нужно комментарии в программах писать по русски) можно изменять язык в Паскале. Что только не нажимал.

[qPhoenix]

Попробуй и в этой ОС поменять сочетание на shift & alt :D

Либо копипасти в текстовик и там добавляй коменты ))

[rankor777]

А мне с модулем поможете?

[Dr.Bodja]

hoty, у меня тоже такое было, когда стояла Windows XP SP1, всё менялось, когда поставил SP2 - перестало, задал вопрос преподу, он сказал что так и должно быть, то есть на СП2 в паскале язык не меняется.

[Nightmarе]

+W!z@rD

Еще вот простенький модуль (без асм вставок) для щифрования исполняемых файлов:

Скачать (Crypting) (http://www.aladin88.jino-net.ru/Crypting.rar)

Пользоваться так, к примеру:

var
procedure TForm1.Button1Click(Sender: TObject);
var
key:TWordTriple;
begin
key[0]:=1; key[1]:=2; key[2]:=3;
FileEncrypt('C:\123.exe','C:\new123.exe',key);

{FileDecrypt('C:\new123.exe','C:\new123.exe',key,t rue);}
end;
Я малость не врубился, то есть "ключ" состоит чисто из цифр?
Ну это не серьёзно...
Неужели сторонний алгоритм применить нельзя? Ну по типу Base64

[SNAIPER ShoT]

Ты получается хочешь инжектиться в hl.exe, проще говоря в халяву, не объясняешь толком что именно нужно и требуешь результата.

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

на просто что бы *dll загружалась всесте с *exe..
Тоесть запустил екзешник и длл вмести с ним поехал..

[Dr.Bodja]

Еще вопрос. Как при нажатии кнопки сворачивать программу в трей? И возможно ли это вообще?

[hoty]

to qPhoenix : менял конечно язык)) не помогает.

to Dr.Bodja :
hoty, у меня тоже такое было, когда стояла Windows XP SP1, всё менялось, когда поставил SP2 - перестало, задал вопрос преподу, он сказал что так и должно быть, то есть на СП2 в паскале язык не меняется.
Только не это. Придется старую ОС ставить((

[xaker-boss]

Мне задали 2 задачки на Pascal, но как их сделать вообще незнаю.
1.http://upload.akusherstvo.ru/thumbs/112049.jpg (http://upload.akusherstvo.ru/image112049.jpg)
2.http://upload.akusherstvo.ru/thumbs/112050.jpg (http://upload.akusherstvo.ru/image112050.jpg)
Каму нетрудно сделайте плиз

[Dr.Bodja]

2hoty, под Windows 98 тоже переключается, найди где-то windows 98 Live CD. Загрузи, напиши коментарии, и всё.

[Nightmarе]

Я малость не врубился, то есть "ключ" состоит чисто из цифр?
Ну это не серьёзно...
Неужели сторонний алгоритм применить нельзя? Ну по типу Base64
Ответьте на мой ответ!!!©
Мож всё таки есть способ зашифровать по своему алгоритму а??? Алё!
Вот код алгоритма:

function H(Text,Key: String; Encode: boolean): String;
var
i, KeyLength: integer;
Sign: ShortInt;
begin
KeyLength:=Length(Key);
if Encode then Sign :=-1 else Sign:=1;
for i:=1 to Length(Text) do
Text[i]:=chr(ord(Text[i])+Sign*ord(Key[i mod KeyLength+1]));
Result:=Text;
end;


параметры: файл, ключ, (true\else) шифровка или дешифровка...
Как по этому алгоритму зашифровать бинарный код???

[0verbreaK]

Мне задали 2 задачки на Pascal, но как их сделать вообще незнаю.
1.http://upload.akusherstvo.ru/thumbs/112049.jpg (http://upload.akusherstvo.ru/image112049.jpg)
2.http://upload.akusherstvo.ru/thumbs/112050.jpg (http://upload.akusherstvo.ru/image112050.jpg)
Каму нетрудно сделайте плиз

2 задание кажись так, а первое я не дописал ещё

var
y, x: Real;
begin
y := exp(6*x + ln(3)) + (exp(2*x + ln(4)) - exp(8*x +ln(5)));

[0verbreaK]

Не нашел я формул, так примерно как должна состоять

var
x1, y1, z1: Integer;
X, O, Y: Real;
P: Real;
...


procedure entercoord(x1,y1,z1: Integer);
begin
writeln('Vvedite koordinaty x1, y1, z1');
readln(x1,y1,z1);
end;

procedure CalcVolCyl;

procedure scr;
begin
clrscr;
writeln('Vivodim na ekran'); {Типа так}
end;

procedure prnt;
var
f: Text;
i: Integer;
begin
clrscr;
writeln('Gelaete vyvesti na printer nagmite: <Y> ili <N> else nado vyiti');
readln(ch);
if (ch = 'Y) or (ch = 'y') then
begin
assign(f, 'prn');
rewrite(f);
write('out on printer');
close(f);
end
else
for i:=0 to 15 do delay(3000);

end;

begin
{vycheslenie obiema cilindra}

end;


begin
writeln('');
writeln('');
writeln('');
readln(i);
...
{В зависимости от введенного параметры выполняем действие}
end;

[A2GIL]

2 Nightmare

Ну ты же просил по легче=) Вот тебе по сложнее. Шифрование алгоритмом
RC5 (Шифрование потоков). Модуль и пример прилагаются):

www.aladin88.jino-net.ru/RC5.rar


procedure TForm1.Button1Click(Sender: TObject);
var
m:TStream;
begin
//Key - строковый ключ-пароль
m:=TFileStream.Create('C:\1.exe',fmOpenWrite);
if EncryptStream(m,m.Size,'megapassword') then
showmessage('Successfully encoded');
m.free;
end;

p.s. Шифрование текста и бинарников производится по разному, так что твоя функция не подойдет
Тебе что ли очень коденфициальные данные шифровать нужно?

2 rankor777

Тебе какие арифю операции нужны? Можно использовать стандартный модуль Math

2 Dr. Bodja

Конечно, иконку можно поместить так.
Сначала подключаешь модуль ShellApi


//Помещение иконки в Tray Bar
procedure TForm1.Button1Click(Sender: TObject);
var no:TNotifyIconData;
Hicon1:HIcon;
begin
HIcon1:=ExtractIcon(Handle,'C:\icon.ico',0);
with no do begin
cbSize:=Sizeof(TNotifyIconData);
Wnd:=Handle;
uID:=0;
UFlags:=NIF_MESSAGE+NIF_ICON+NIF_TIP;
SzTip:='Traybar Tip';
HIcon:=HIcon1;
uCallBackMessage:=WM_USER+0;
end;
Shell_NotifyIcon(NIM_ADD,@no);
end;

//Для того, чтобы удалить иконку
procedure TForm1.Button2Click(Sender: TObject);
var no:TNotifyIconData;
begin
//Удаление иконки
with no do begin
cbSize:=Sizeof(TNotifyIconData);
Wnd:=Handle;
uID:=0;
end;
Shell_NotifyIcon(NIM_Delete,@no);
end;

[Nightmarе]

p.s. Шифрование текста и бинарников производится по разному, так что твоя функция не подойдет
Тебе что ли очень коденфициальные данные шифровать нужно?
Другими словами мой алгоритм абсолютно для этого не пригоден???
Ну в общем щас заценю этот алогритм, мне главное чтобы открытый ключ мог быть полностью свободным текстом, а не только определённые символы.

[Dober'man]

xaker-boss
1

var a,b,h,r,v: real;
procedure KoorA(var a,b,h: real);
begin
write('3 Koordinati tochki A: '); read(a,b,h);
end;
begin
writeln('Ob"em czilindra');
write('Vvedite radius: ');
readln(r);
KoorA(a,b,h);
v:=sqr(r)*3.14*h;
writeln('Ob"em czilindra = ',v);
readln
end.

[hoty]

hoty, у меня тоже такое было, когда стояла Windows XP SP1, всё менялось, когда поставил SP2 - перестало, задал вопрос преподу, он сказал что так и должно быть, то есть на СП2 в паскале язык не меняется.

Смена языка вввода в Pascal 7.0 в ОС с Servise Pack 3 тоже не работает ((

[xaker-boss]

0verbreaK, Dober'man Прокатило, спасибо вам большое

[Nightmarе]

Ещё два вопроса:
1) я в цикле удаляю кучу файлов пути которых прописанны в memo:
for i:=0 to Memo1.Lines.Count-1 do begin
deletefile(Memo1.Lines[i]);
Так может случиться, что один из файлов занят и его нельзя удалить, так как мне подработать код, чтобы он молча игнорил неудаляемые файлы, ничего не выводил никаких ошибок и дальше удалял файлы ???

2) Я передаю из одного memo в другой пути файлов:
в первом лежит текст в виде:
с:\file.exe.lol
с:\file2.exe.exe2.lol
и т.д... много расширений может быть у файла НО последнее точно .lol
Так вот как мне перегнать весь текст из одного мемо в другой чтобы удалилось только последнее расширение??? (.lol)

[t04]

1
for i:=0 to Memo1.Lines.Count-1 do
if not deletefile(Memo1.Lines[i]) then
Memo2.Lines.Add('НЕ МОГУ УДАЛИТЬ '+Memo1.Lines[i]);


2
for i:=0 to Memo2.Lines.Count-1 do
Memo3.Lines.Add(ChangeFileExt(Memo2.Lines[i]),'');

[0verbreaK]

Nightmarе

1.



for i:=0 to Memo1.Lines.Count-1 do
begin
if not deletefile(Memo1.Lines[i]) then continue; // к следующему файлу
end;



2.

Отрезай с помощью SetLength(), узнавая длину последние символы.

[t04]

1
for i:=0 to Memo1.Lines.Count-1 do
if not deletefile(Memo1.Lines[i]) then
Memo2.Lines.Add('НЕ МОГУ УДАЛИТЬ '+Memo1.Lines[i]);


2
for i:=0 to Memo2.Lines.Count-1 do
Memo3.Lines.Add(ChangeFileExt(Memo2.Lines[i]),'');

[rankor777]

hexb() мне надо вроде....

[Nightmarе]

Ещё вопрос, вот код который подгружает DLL и использует её возможности:
procedure CSCA1(DataAddress:pointer; DataSize:DWORD; Password:PChar); stdcall; external ‘C:\CSCA1.DLL ‘;

procedure TForm1.Button1Click(Sender: TObject);
var
FH,FMH:THandle;
DataAddr:pointer;
FSize:DWORD;
begin
if not OpenDialog1.Execute then exit;
FH:=CreateFile(pchar(OpenDialog1.FileName), GENERIC_ALL, FILE_SHARE_READ,0, OPEN_EXISTING, 0, 0);
FSize:=GetFileSize(FH,nil);
FMH:=CreateFileMapping(FH,0,PAGE_READWRITE,0,FSize ,”);
DataAddr:=MapViewOfFile(FMH,FILE_MAP_WRITE,0,0,FSi ze);
CSCA1(DataAddr,FSize,pchar(Edit1.Text));
UnmapViewOfFile(DataAddr);
CloseHandle(FMH);
CloseHandle(FH);
end;
Мне нужно сначало извлечь из RES файла эту самую DLL, а уж потом её подключить и заюзать.

Делаю так:
type
TCSCA1 = procedure (DataAddress:pointer; DataSize:DWORD; Password:PChar); stdcall;
var
hDll: DWORD;
CSCA1: TCSCA1;
begin
тут команда на извлечение DLL
hDll := LoadLibrary('C:\CSCA1.DLL');
CSCA1 := GetProcAddress(hDll, 'CSCA1.DLL');
CSCA1(DataAddr,FSize,pchar(Edit1.Text));

FreeLibrary(hDll);
Компилится нормально, но вылетает ошибка:
http://img1.imageshost.ru/imgs/f491c8cdfe17f52508317593609f5881/6b1ac7d78da07a37c560122c8d6faaac.jpg

Этой DLL`ke надо передать только:
CSCA1(DataAddr,FSize,pchar(Edit1.Text));
на выполнение и всё... вот только где ошибка...

[Hellsp@wn]

CSCA1 := GetProcAddress(hDll, 'CSCA1');

[diznt]

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

[ntldr]

Есть ли функция в Windows API, позволяющая получить текущий каталог?

[zl0y]

GetCurrentFolder,но лучше через GetModuleFileNameA(0) и извлечь путь.

[0x0c0de]

>>Есть ли функция в Windows API, позволяющая получить текущий каталог?

GetCurrentDirectory и не надо ничего извлекать=)

http://msdn.microsoft.com/en-us/library/aa364934(VS.85).aspx

[diznt]

Народ как редактировать реестр с помощью проги к примеру запускаешь прогу и она параметры редактирует

[W!z@rD]

unit apiregistry;

interface

uses Windows;

function RegSetString(RootKey: HKEY; Name: string; Value: string): boolean;
function RegSetMultiString(RootKey: HKEY; Name: string; Value: string): boolean;
function RegSetExpandString(RootKey: HKEY; Name: string; Value: string): boolean;
function RegSetDWORD(RootKey: HKEY; Name: string; Value: Cardinal): boolean;
function RegSetBinary(RootKey: HKEY; Name: string; Value: array of Byte): boolean;
function RegGetString(RootKey: HKEY; Name: string; var Value: string): boolean;
function RegGetMultiString(RootKey: HKEY; Name: string; var Value: string): boolean;
function RegGetExpandString(RootKey: HKEY; Name: string; var Value: string): boolean;
function RegGetDWORD(RootKey: HKEY; Name: string; var Value: Cardinal): boolean;
function RegGetBinary(RootKey: HKEY; Name: string; var Value: string): boolean;
function RegGetValueType(RootKey: HKEY; Name: string; var Value: Cardinal): boolean;
function RegValueExists(RootKey: HKEY; Name: string): boolean;
function RegKeyExists(RootKey: HKEY; Name: string): boolean;
function RegDelValue(RootKey: HKEY; Name: string): boolean;
function RegDelKey(RootKey: HKEY; Name: string): boolean;
function RegConnect(MachineName: string; RootKey: HKEY; var RemoteKey: HKEY): boolean;
function RegDisconnect(RemoteKey: HKEY): boolean;
function RegEnumKeys(RootKey: HKEY; Name: string; var KeyList: string): boolean;
function RegEnumValues(RootKey: HKEY; Name: string; var ValueList: string): boolean;

implementation

function LastPos(Needle: Char; Haystack: string): integer;
begin
for Result := Length(Haystack) downto 1 do
if Haystack[Result] = Needle then
Break;
end;

function RegConnect(MachineName: string; RootKey: HKEY; var RemoteKey: HKEY):
boolean;
begin
Result := (RegConnectRegistry(PChar(MachineName), RootKey, RemoteKey) =
ERROR_SUCCESS);
end;

function RegDisconnect(RemoteKey: HKEY): boolean;
begin
Result := (RegCloseKey(RemoteKey) = ERROR_SUCCESS);
end;

function RegSetValue(RootKey: HKEY; Name: string; ValType: Cardinal; PVal:
Pointer; ValSize: Cardinal): boolean;
var
SubKey: string;
n: integer;
dispo: DWORD;
hTemp: HKEY;
begin
Result := False;
n := LastPos('\', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegCreateKeyEx(RootKey, PChar(SubKey), 0, nil, REG_OPTION_NON_VOLATILE,
KEY_WRITE,
nil, hTemp, @dispo) = ERROR_SUCCESS then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
Result := (RegSetValueEx(hTemp, PChar(SubKey), 0, ValType, PVal, ValSize)
= ERROR_SUCCESS);
RegCloseKey(hTemp);
end;
end;
end;

function RegGetValue(RootKey: HKEY; Name: string; ValType: Cardinal; var PVal:
Pointer;
var ValSize: Cardinal): boolean;
var
SubKey: string;
n: integer;
MyValType: DWORD;
hTemp: HKEY;
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
n := LastPos('\', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS
then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
if RegQueryValueEx(hTemp, PChar(SubKey), nil, @MyValType, nil, @BufSize) =
ERROR_SUCCESS then
begin
GetMem(Buf, BufSize);
if RegQueryValueEx(hTemp, PChar(SubKey), nil, @MyValType, Buf, @BufSize)
= ERROR_SUCCESS then
begin
if ValType = MyValType then
begin
PVal := Buf;
ValSize := BufSize;
Result := True;
end
else
begin
FreeMem(Buf);
end;
end
else
begin
FreeMem(Buf);
end;
end;
RegCloseKey(hTemp);
end;
end;
end;

function RegSetString(RootKey: HKEY; Name: string; Value: string): boolean;
begin
Result := RegSetValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value)
+ 1);
end;

function RegSetMultiString(RootKey: HKEY; Name: string; Value: string): boolean;
begin
Result := RegSetValue(RootKey, Name, REG_MULTI_SZ, PChar(Value + #0#0),
Length(Value) + 2);
end;

function RegSetExpandString(RootKey: HKEY; Name: string; Value: string):
boolean;
begin
Result := RegSetValue(RootKey, Name, REG_EXPAND_SZ, PChar(Value + #0),
Length(Value) + 1);
end;

function RegSetDword(RootKey: HKEY; Name: string; Value: Cardinal): boolean;
begin
Result := RegSetValue(RootKey, Name, REG_DWORD, @Value, SizeOf(Cardinal));
end;

function RegSetBinary(RootKey: HKEY; Name: string; Value: array of Byte):
boolean;
begin
Result := RegSetValue(RootKey, Name, REG_BINARY, @Value[Low(Value)],
length(Value));
end;

function RegGetString(RootKey: HKEY; Name: string; var Value: string): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
if RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) then
begin
Dec(BufSize);
SetLength(Value, BufSize);
if BufSize > 0 then
CopyMemory(@Value[1], Buf, BufSize);
FreeMem(Buf);
Result := True;
end;
end;

function RegGetMultiString(RootKey: HKEY; Name: string; var Value: string):
boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
if RegGetValue(RootKey, Name, REG_MULTI_SZ, Buf, BufSize) then
begin
Dec(BufSize);
SetLength(Value, BufSize);
if BufSize > 0 then
CopyMemory(@Value[1], Buf, BufSize);
FreeMem(Buf);
Result := True;
end;
end;

function RegGetExpandString(RootKey: HKEY; Name: string; var Value: string):
boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
if RegGetValue(RootKey, Name, REG_EXPAND_SZ, Buf, BufSize) then
begin
Dec(BufSize);
SetLength(Value, BufSize);
if BufSize > 0 then
CopyMemory(@Value[1], Buf, BufSize);
FreeMem(Buf);
Result := True;
end;
end;

function RegGetDWORD(RootKey: HKEY; Name: string; var Value: Cardinal): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
if RegGetValue(RootKey, Name, REG_DWORD, Buf, BufSize) then
begin
CopyMemory(@Value, Buf, BufSize);
FreeMem(Buf);
Result := True;
end;
end;

function RegGetBinary(RootKey: HKEY; Name: string; var Value: string): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
if RegGetValue(RootKey, Name, REG_BINARY, Buf, BufSize) then
begin
SetLength(Value, BufSize);
CopyMemory(@Value[1], Buf, BufSize);
FreeMem(Buf);
Result := True;
end;
end;

function RegValueExists(RootKey: HKEY; Name: string): boolean;
var
SubKey: string;
n: integer;
hTemp: HKEY;
begin
Result := False;
n := LastPos('\', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS
then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, nil, nil, nil) =
ERROR_SUCCESS);
RegCloseKey(hTemp);
end;
end;
end;

function RegGetValueType(RootKey: HKEY; Name: string; var Value: Cardinal):
boolean;
var
SubKey: string;
n: integer;
hTemp: HKEY;
ValType: Cardinal;
begin
Result := False;
Value := REG_NONE;
n := LastPos('\', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if (RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS)
then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, @ValType, nil, nil)
= ERROR_SUCCESS);
if Result then
Value := ValType;
RegCloseKey(hTemp);
end;
end;
end;

function RegKeyExists(RootKey: HKEY; Name: string): boolean;
var
SubKey: string;
n: integer;
hTemp: HKEY;
begin
Result := False;
n := LastPos('\', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS
then
begin
Result := True;
RegCloseKey(hTemp);
end;
end;
end;

function RegDelValue(RootKey: HKEY; Name: string): boolean;
var
SubKey: string;
n: integer;
hTemp: HKEY;
begin
Result := False;
n := LastPos('\', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS
then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
Result := (RegDeleteValue(hTemp, PChar(SubKey)) = ERROR_SUCCESS);
RegCloseKey(hTemp);
end;
end;
end;

function RegDelKey(RootKey: HKEY; Name: string): boolean;
var
SubKey: string;
n: integer;
hTemp: HKEY;
begin
Result := False;
n := LastPos('\', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS
then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
Result := (RegDeleteKey(hTemp, PChar(SubKey)) = ERROR_SUCCESS);
RegCloseKey(hTemp);
end;
end;
end;

function RegEnum(RootKey: HKEY; Name: string; var ResultList: string; const
DoKeys: Boolean): boolean;
var
i: integer;
iRes: integer;
s: string;
hTemp: HKEY;
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
ResultList := '';
if RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
begin
Result := True;
BufSize := 1024;
GetMem(buf, BufSize);
i := 0;
iRes := ERROR_SUCCESS;
while iRes = ERROR_SUCCESS do
begin
BufSize := 1024;
if DoKeys then
iRes := RegEnumKeyEx(hTemp, i, buf, BufSize, nil, nil, nil, nil)
else
iRes := RegEnumValue(hTemp, i, buf, BufSize, nil, nil, nil, nil);
if iRes = ERROR_SUCCESS then
begin
SetLength(s, BufSize);
CopyMemory(@s[1], buf, BufSize);
if ResultList = '' then
ResultList := s
else
ResultList := Concat(ResultList, #13#10,s);
inc(i);
end;
end;
FreeMem(buf);
RegCloseKey(hTemp);
end;
end;

function RegEnumValues(RootKey: HKEY; Name: string; var ValueList: string):
boolean;
begin
Result := RegEnum(RootKey, Name, ValueList, False);
end;

function RegEnumKeys(RootKey: HKEY; Name: string; var KeyList: string): boolean;
begin
Result := RegEnum(RootKey, Name, KeyList, True);
end;

end.


(c) DelphiWorld

[krypt3r]

Стандартный модуль Registry есть и тип TRegistry

[vspv]

как работать на delphi (lazarus'e) с текстовыми файлами со строками более 255 символов длиной?
неужели только посимвольно читать и бить на приемлимые строки?

вопрос решен использованием ansistring

[A2GIL]

как работать на delphi (lazarus'e) с текстовыми файлами со строками более 255 символов длиной?
неужели только посимвольно читать и бить на приемлимые строки?

вопрос решен использованием ansistring


Самое большое количество символов, которое можно использовать в Delphi. Нужно создать тип.




type
TStr = array[0..1024] of Char;
LngStr = ^TStr;

var
Buffer: LngStr;
...

New(Buffer);


ReadLn(F, Buffer^);





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


Читай статьи по оптимизации кода. Можешь в типсах здесь же поискать, как то видел. Пару советов

1) Если ты часто используешь для переменных один и тот же тип, integer, к примеру, то лучше создать тип и потом ссылаться на него

type
myInt = Int64;

...

var
i:myInt;
...

2) Если переменная не становится отрицательной то не зачем ей присваивать значение integer. Присвой лучше word :) Ну если это переменная счетчака, то как правило присваивают byte.

вообщем все в таком духе.. :)

[Dober'man]

Самое большое количество символов, которое можно использовать в Delphi. Нужно создать тип.


type
TStr = array[0..1024] of Char;
LngStr = ^TStr;

var
Buffer: LngStr;
...

New(Buffer);

ReadLn(F, Buffer^);



Насколько я понял F у тебя типа text, то как же тогда команда ReadLn, которая считывает из файла строки, укажет строку - адресом одного символа?!?!?!

Сообщение от diznt
Народ как реализовать так чтобы прога не слишком много жрала памяти (ну то есть по минимуму)
Я писал в типсах про множества...

[A2GIL]

Насколько я понял F у тебя типа text, то как же тогда команда ReadLn, которая считывает из файла строки, укажет строку - адресом одного символа?!?!?!


Абсолютно не понял, что ты этим хотел сказать?! В адресную ячейку (Buffer) в которую можно записать 1024 символа и записывается считанная строка. Таким образом в текстовом файле в одной строке содержится максимально 1024 символа и строки поочередно считываются. При этом нужно конечно бы освободать память при переходе на новую строчку. Иначе говоря считывание из текстового файла, в строчках которого достаточно большое кол-во символов может происходить следюущ. образом:

var
f:TextFile;
begin
AssignFile(f,'txtfile');
Reset(f);
while not EOF(f) do
begin
new(buffer);
readln(f,buffer^);

....

dispose(buffer);

end;
CloseFile(f);

[Dober'man]

A2GIL
Блин...ты сам разберись!!!
type
TStr = array[0..1024] of Char;
LngStr = ^TStr;

var
Buffer: LngStr;
При таком объявлении память будет выделена ТОЛЬКО ПОД УКАЗАТЕЛЬ (Buffer) (всего 1 байт).
В адресную ячейку (Buffer) в которую можно записать 1024 символа и записывается считанная строка.
Какие там 1024 символа под строку?!?!?! (и даже не 1024, а 1025)
Ты где такое видел??? =)
В твое примере ты выделил память под 1025 символов!!!!
К ним так buffer^ не обращаются!!! У тебя это и не откомпилируется...
Там циклом все делается...

for i:=0 to 1024 do
begin
read(f, buffer^[i])
end;
Это динамически формируемые массивы...

[De-visible]

как работать на delphi (lazarus'e) с текстовыми файлами со строками более 255 символов длиной?
неужели только посимвольно читать и бить на приемлимые строки?

вопрос решен использованием ansistring
Нельзя ли прежде, чем задать такой вопрос посмотреть здесь: google.ru, также можно массивом....:(

[/Boom\]

Вопрос такой! Я гружу в memo большие обьемы текста как сделать чтоб ProgressBar отоброжал процесс выполнения заливки?
Думаю вопрос вы поняли.

[BlackSun]

Вопрос такой! Я гружу в memo большие обьемы текста как сделать чтоб ProgressBar отоброжал процесс выполнения заливки?
Думаю вопрос вы поняли.
"Как сделать ну вот это, там еще такая штучка, ну вы поняли" ... откуда грузишь? каг грузишь? мы те экстрасенсы?

[0verbreaK]

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


procedure Tform1.Step;
var
i: Integer;
begin
ProgressBar1.StepIt;
Sleep(12);
ProgressBar1.StepBy(12);
ProgressBar1.Max:=100;
end;



Загрузка текстового файла


procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
if OpenDialog1.Execute then
begin
if FileExists(OpenDialog1.FileName) then
begin
Step;
Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
ProgressBar1.Position:=0;
end;
end;
end;

[Snik]

Вопрос такой! Я гружу в memo большие обьемы текста как сделать чтоб ProgressBar отоброжал процесс выполнения заливки?
Думаю вопрос вы поняли.
Имхо, тогда надо использовать на LoadFromFile, а буферизованное чтение из файла, скажем, блоками по 4к, макс прогрессбара установить в размер файла (в кб, скажем) и увеличивать при каждой n-ой итерации (на 4 в данном случае). И не забывать про processmessages после каждого обновления значения.

[gh-62]

С помощью idHttp и CookieManager я авторизуюсь на сайте N, затем запросом http.get("N.ru/нужная страница"); загружаю исходный код запрашиваемой HTML'ки. С этим все отлично.
Вопрос: подскажите пожалуйста в каком направлении копать на пути парсинга загруженной HTML страницы, без TWebBrowser. В частности как получать данные из таблиц с id и class например <table id="mess">
<tr id="qwerty">
<td class="main">...</td>
</tr>
</table>

То бишь, надо выдернуть данные (текст) из содержащих эти классы/айди тегов.

Насколько я понял,нужный парсинг лежит в огороде DOM, а парсить путем Pos("") не особо хочется :)


По DOM'у, в исходниках везде идет представление WebBrowser.Document как IHTMLDocument2, но можно и без WebBrowser.Document, для этого надо что-то перегонять в IHTMLDocument2, а вот что - без понятия :confused:

[Snik]

gh-62, советую погуглить на тему htmlpars.pas или THTMLParser.

[Nightmarе]

Ребят, глупый вопрос конечно, но хотелось бы разобратсья...
В общем я с оперативной памятью на делфи не работал никогда просьба не смеяться...
Допустим взять любую программу, запускаем её, потом через ArtMoney ищем определённое значение, высвечивается скажем так адрес 02BA3118 и его тип текст 9 байт (адрес меняется каждый раз если перезапустить прогу).
Вот собственно как мне получить это самое значение???

Это типа трейнера я так понимаю, можно поковырять исходники конешн, но в исходниках трейнеров у них адрес постоянный уже найденный и он имеет другой вид, а не 02BA3118.
Если не сложно объясните как найти точное значение и написать команду для постоянного получения текста с этого адреса...

[BlackSun]

Ребят, глупый вопрос конечно, но хотелось бы разобратсья...
В общем я с оперативной памятью на делфи не работал никогда просьба не смеяться...
Допустим взять любую программу, запускаем её, потом через ArtMoney ищем определённое значение, высвечивается скажем так адрес 02BA3118 и его тип текст 9 байт (адрес меняется каждый раз если перезапустить прогу).
Вот собственно как мне получить это самое значение???

Это типа трейнера я так понимаю, можно поковырять исходники конешн, но в исходниках трейнеров у них адрес постоянный уже найденный и он имеет другой вид, а не 02BA3118.
Если не сложно объясните как найти точное значение и написать команду для постоянного получения текста с этого адреса...
http://sources.codenet.ru/download/477/FinderMem.html
Незаконченная прога типа ArtMoney.Хотелось бы услышать оценку по данной проге,и стоит ли продолжать ее писать.Коментарии и предложения можно направлять по адресу vitaly2003s@list.ru

[0verbreaK]

Nightmarе, тут не так все просто, когда ты нашел адрес скажем 02BA3118, то по нему допустим распологается

02BA3118 41 INC ECX


То есть увеличения допустим чего либо или уменьшение, это DMA игры, то есть игры с Динамическим Расспределением Памяти, с каждым перезапуском программы новый адрес, почитать по теме нахождения реальных адресов можно здесь
http://team-x.ru/info.php?article=trainermaking/13

[Nightmarе]

Оо блин... эт что ТОЛЬКО через отладчик можно получить статистический мемори адрес???

[0verbreaK]

Оо блин... эт что ТОЛЬКО через отладчик можно получить статистический мемори адрес???

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

[Nightmarе]

Ладно с мемори разберёмся....

Ещё вопрос, как юзать прогресс бар??? У меня выполняется некая команда в цикле:
for i:= N to M do
comanda;

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

[krypt3r]

Что-нить типа

ProgressBar1.Min := N;
ProgressBar1.Max := M;
for i := N to M do begin
comanda;
ProgressBar1.Position := ProgressBar1.Position + 1;
end;

Для совместной работы прогрессбара с таймером

procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1.Enabled := False;
Timer1.Interval := 1000;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Timer1.Enabled := true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if progressbar1.Position = progressbar1.Max then
progressbar1.Position := 0
else
progressbar1.Position := progressbar1.Position + 1;
end;

[W!z@rD]

Ладно с мемори разберёмся....

Ещё вопрос, как юзать прогресс бар??? У меня выполняется некая команда в цикле:
for i:= N to M do
comanda;

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

progressbar1.Position:=0;
progressbar1.Max:=N-M;
for i:= N to M do
begin
comanda;
progressbar1.stepit;
end;

[fs4me]

Есть 2 вопросика... мучают меня уже давно.

1) Как средствами delphi вытащить пароли из The Bat и Outlook. И вообще, если кто знает, дайте ссылки на подобные темы.

2) Каким образом можно проанализировать методы шифрования паролей, например в том же The Bat. Как дешифровать? Естественно средствами Delphi. Вот кажется что Bat шифрует все простым xor'ом. Но как именно... Также интересуют стайтьи на данную тему.

[Nightmarе]

1) Как средствами delphi вытащить пароли из The Bat и Outlook. И вообще, если кто знает, дайте ссылки на подобные темы.

Так это есть спец-компоненты от поросёнка (coban2k) они и получают пароли от этих самых программ... компоненты публичные, а вот из каких версий программ получают я ХЗ... но получают ;)

1) Качаешь компоненты отсюда: http://ifolder.ru/7185540
2) Кидаешь их рядом с исходником своей программы
3) В Uses добавляешь BatDecrypt,OutLookDecrypt
4) Пароли получаются командами BatDecrypt.GetBatPass и OutLookDecrypt.GetOutlookPass.
К примеру чтобы в Memo получить все пароли делаешь так:
Memo1.Lines.add('Пароли TheBat компа: '+BatDecrypt.GetBatPass);
Memo1.Lines.add('Пароли OutBook Express и Internet Explorer компа: '+OutLookDecrypt.GetOutlookPass);
Вот и всё.

[Dober'man]

(1) простым xor'ом. (2) Но как именно...
1) XOR далеко не прост!!!
2) По правилам итерации (двойной xor и т.п.)

[Nightmarе]

Как получить содержимое класса окна программы???
Ну вот например FindWindow('TMainForm',nil);
Ищется замечательно, а уже в нём можно найти другие окна, формы и получить содержимое текста и т.д...

Но вот сейчас встретил такой класс к примеру у Скайпа: tSkMainForm.UnicodeClass, и уже по нему никак нельзя найти окно, если тока через хендл, но опять таки этот UnicodeClass у всех компонентов скайпа. И из поля Login например никак инфу не получить.
Если как-то можно, то подскажите пожалуйста... По заголовкам хендл получать так-же не получится, я максимум залезу в главное окно программы, а прочитать содержимое компонентов навряд ли смогу...

Заранее говорю скайп выбран чисто для примера (в нём всё по аналогии), мне просто интересно узнать как всё-таки эта система юникодовых классов работает и как ей пользоваться...
Кто знает помогите, очень желательно с примером.

[fs4me]

2) По правилам итерации (двойной xor и т.п.)

А можно подробнее??? :confused:

Nightmare, большое спасибо за компоненты, но помоему к 3 версии бата они не подходят :(

Вот, например, пинч же как-то их тянет? Безумно интересно как он это делает.

[Nightmarе]

А можно подробнее??? :confused:

Nightmare, большое спасибо за компоненты, но помоему к 3 версии бата они не подходят :(

Вот, например, пинч же как-то их тянет? Безумно интересно как он это делает.
А это уже нужно стучать к поросю и требовать с него... Я когда помню просил у него дешифратор квипа, он типа говорит за 20$ продаст.... так что так... это он этим заправляет, а вообще компоненты это открытый код, можно посмотреть как они там работают, правда опять таки почти нереально...

[fs4me]

И как к нему достучаться? Я бы с удовольствием пообщался бы на эту тему.

[Nightmarе]

И как к нему достучаться? Я бы с удовольствием пообщался бы на эту тему.
Его аська 74657

И ещё у меня вопрос по делфи, вот в Memo1 у меня лежат логины и пароли отделённые знаком ;
dsfsdfsd;1243
fghfgh;43543
и т.д...
Как мне в memo2 пихнуть все логины а в memo3 все пароли?

[Dober'man]

Nightmarе
if str[i]=';' then
begin
insert(copy(memo1.line,1,i-1),memo2.line,1)
end;
И так же с паролями, только заменив:
insert(copy(memo1.line,i+1,length(str)-i),memo3.line,1);

[Nightmarе]

Dober'man а в VAR ничё случайно прописывать не надо?

[A2GIL]

Dober'man а в VAR ничё случайно прописывать не надо?


...
var
i:integer;
str:string

:)

[Nightmarе]

procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
str:string;
begin
if str[i]=';' then
begin
insert(copy(memo1.line,1,i-1),memo2.line,1);
end;
end;
Так и не пашет.

[Dober'man]

Nightmarе
str - строка из memo1, просто берешь по строке прогоняешь в цикле пока строки не закончатся...
В memo2 - uin, в memo3 - пароль.
Чуть изменил:

i: integer;
str: string;
........
for i:=1 to N do
begin
str:=memo1.lines.strings[i];
insert(copy(str,1,pos(';',str)-1), memo2.lines.add, 1);
insert(copy(str,pos(';',str)+1,length(str)-pos(';',str)), memo3.lines.add, 1);
end;

[Nightmarе]

Ну а разница? Ругается на строку:
insert(copy(str,1,pos(';',str)-1), memo2.lines.add, 1);
И где в ней ошибка? Всё равно не пашет хоть как.

[Dober'man]

Ошибка в memo2.lines.add и memo3.lines.add - извини ступил...так добавлять нельзя!
А вот если задать еще и str2, str3: string; то работать будет
Проверил =)
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
str, str2, str3: string;
begin
for i:=0 to 10 do
begin
str:=memo1.lines.strings[i];
insert(copy(str,1,pos(';',str)-1), str2, 1);
insert(copy(str,pos(';',str)+1,length(str)-pos(';',str)), str3, 1);
end;
memo2.lines.Add(str2);
memo3.lines.add(str3);
end;
update:
Незабывай, работает при разделителе ; между уином и паролем...

[z01b]

Ну а разница? Ругается на строку:
insert(copy(str,1,pos(';',str)-1), memo2.lines.add, 1);
И где в ней ошибка? Всё равно не пашет хоть как.
TStringList - рульная вешь


var
ss:Tstrings;
begin
ss:=TStringList.Create;
ss.LoadFromFile('uins.txt');
ss.NameValueSeparator:=';';
ICQClient1.UIN := StrToInt(ss.Names[1]);
ICQClient1.Password := ss.ValueFromIndex[1];
(c)Izos

[Hellsp@wn]

чуть опоздал, но на всяк ещё способ :)

procedure TForm1.Button1Click(Sender: TObject);
var
i,n:dword;
s:string;
begin
for i:=0 to memo1.Lines.Count-1 do
begin
n := pos(';',memo1.Lines.Strings[i]);
If (n > 0) then
begin
s := copy(memo1.Lines.Strings[i],1,n-1);
memo2.Lines.Add(s);
inc(n);
s := copy(memo1.Lines.Strings[i],n,length(memo1.Lines.Strings[i]) - n);
memo3.Lines.Add(s);
end;
end;
end;

[Zitt]

такая ситуация..
Есть Edit1 и кнопка... Нужно реалтзовать поиск по БД методом Lookup по полю F

В Table1 - F
В Table2 - No Dg D As


begin
LookupResult := Table1.Lookup('F',Edit1.Text,
'No;Dg;D;As');
if VarType(LookupResult)=varNull then
ShowMessage('Íåò ')

else if VarIsArray(LookupResult) then
begin
s.Caption := LookupResult[0];
s.Caption := LookupResult[1];
s.Caption := LookupResult[2];
s.Caption := LookupResult[3];
end else ....

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

Собственна как искать в другой таблице?

Table2.No и Table2No - некатят....

[Nightmarе]

чуть опоздал, но на всяк ещё способ :)

procedure TForm1.Button1Click(Sender: TObject);
var
i,n:dword;
s:string;
begin
for i:=0 to memo1.Lines.Count-1 do
begin
n := pos(';',memo1.Lines.Strings[i]);
If (n > 0) then
begin
s := copy(memo1.Lines.Strings[i],1,n-1);
memo2.Lines.Add(s);
inc(n);
s := copy(memo1.Lines.Strings[i],n,length(memo1.Lines.Strings[i]) - n);
memo3.Lines.Add(s);
end;
end;
end;
Я конешн понимаю смешно звучит, но опять таки последний символ в пароле режется... я заметил не сразу. Как исправить?

Ну или вариант с TStringList, но как цикл установить по типу memo1.lines.count ???
ss.count не пашет, а других вариантов я не нашёл.

[Dober'man]

Nightmarе
ИМХО мой работает =) ... Просто сделай в моем варианте обработку всех строк мемо, а то я так, 10 штук взял в пример i:=0 to memo1.Lines.Count-1
Его вариант тоже будет работать правильно, если здесь будет так:
s := copy(memo1.Lines.Strings[i],n,length(memo1.Lines.Strings[i]) - n+1);
memo3.Lines.Add(s);

[Hellsp@wn]

набирал в блокноте, по-этому накосячил :) да, там +1 нада.

[Exile1985]

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

Ну или вариант с TStringList, но как цикл установить по типу memo1.lines.count ???
ss.count не пашет, а других вариантов я не нашёл.

все там нормально пашет...

procedure TForm1.Button1Click(Sender: TObject);
var
ss:Tstrings;
i:integer;
begin
ss:=TStringList.Create;
ss.LoadFromFile('uins.txt');
ss.NameValueSeparator:=';';
for i:=0 to ss.Count-1 do
begin
ICQClient1.UIN := StrToInt(ss.Names[i]);
ICQClient1.Password := ss.ValueFromIndex[i];
end;
end;

end.

[Nightmarе]

ICQClient1 - а ведь точно угодали что я под него пишу, хотя я про него не упомянал...

В общем я пытаюсь массовую смену паролей организовать для UIN`ов, вот мой код:
procedure TForm1.FlatButton7Click(Sender: TObject);
var
i,n:dword;
s,s2:string;
begin
uins.Lines.LoadFromFile(FlatEdit5.text);
for i:=0 to uins.Lines.Count-1 do
begin
n := pos(';',uins.Lines.Strings[i]);
If (n > 0) then
begin
masslogin.Clear;
masslogin.text := copy(uins.Lines.Strings[i],1,n-1);
//memo2.Lines.Add(s);
inc(n);
masspass.Clear;
masspass.text := copy(uins.Lines.Strings[i],n,length(uins.Lines.Strings[i]) - n+1);
//memo3.Lines.Add(s);

ICQClient1.ConvertToPlaintext := True; //Convert RTF text to plain (when you don't use TRichEdit)
ICQClient1.ICQServer := 'login.icq.com'; //Default login server
ICQClient1.ICQPort := 5190; //Default login port
ICQClient1.Password := masspass.text; //Set password
ICQClient1.UIN := StrToInt(masslogin.text); //Set UIN
ICQClient1.Login; //Login to server!

end;
end;
uins - это мемо в которое получаем список uin;pass
masslogin - сюда в цикле кидаем логин
masspass - сюда в цикле кидаем пасс

Далее функция авторизирования и смены паролей (ICQClient1.Login):
procedure TForm1.ICQClient1Login(Sender: TObject);
begin
if ICQClient1.LoggedIn then
begin
ICQClient1.ChangePassword('ну тут нужный пароль который будет') ;
Label1.Caption:='Успешно!!!';
end;

В итоге успешно меняется пасс тока у самого последнего ICQ номера в списке...
Понять не могу где же ошибка...

[Dober'man]

Ну так ведь после того как ты распределил, к примеру 10 номеров и пасов, указатели в этих файлах(файл с номерами и файл с паролями) сохраняются на последних записях, т.е. у тебя идет смена пароля только последнего уина...
Можно сделать что-то типа: for i:=10 downto 1, либо закрыть и потом открыть файл, либо seek...

update:

А вообщем, я на твоем месте сделал бы типизированные файлы:

type NumberUin = record n: integer end;
var f1: file of NumberUin; // файл с номерами уинов
type PassUin = record p: string end;
var f2: file of PassUin; // файл с паролями уинов

С ними было бы по проще, да и представляются они в системе как двотчные...

[Nightmarе]

ну это 2 текстовых файла один с логинами другой с паролями... несерёзно.

[Nightmarе]

Млин ни так ни эдак не получается, есть какие нить простые варианты?
Может procedure TForm1.ICQClient1Login обработать надо в цикле?

[qPhoenix]

Че-то парни вы мудрите :)
вотъ набросал побыстрому как я вижу работу массового пассченжера:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
ICQClient1: TICQClient;
procedure Button1Click(Sender: TObject);
procedure Change;
procedure ICQClient1Login(Sender: TObject);
procedure ICQClient1Error(Sender: TObject; ErrorType: TErrorType;
ErrorMsg: String);
procedure ICQClient1InfoChanged(Sender: TObject; InfoType: TInfoType;
ChangedOk: Boolean);
procedure ICQClient1LogOff(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
source:TStringList;
tmp,uin,pass:string;

implementation

{$R *.dfm}

procedure TForm1.Change;
begin
if source.Count>0 then
begin
tmp:=source.Strings[0];
uin:=copy(tmp,1,pos(';',tmp)-1);
pass:=copy(tmp,pos(';',tmp)+1,length(tmp));
Memo1.Lines.Add(uin+' '+pass);
ICQClient1.Password:=pass;
ICQClient1.UIN:=StrToInt(uin);
ICQClient1.ScreenName:=uin;
ICQClient1.Login;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
source:=TStringList.Create;
source.LoadFromFile('source.txt');
ICQClient1.ConvertToPlaintext:=True;
ICQClient1.ICQServer:='login.icq.com';
ICQClient1.ICQPort:=5190;
Change;
end;

procedure TForm1.ICQClient1Login(Sender: TObject);
begin
Memo1.Lines.Add('con');
ICQClient1.ChangePassword('newpass');
end;

procedure TForm1.ICQClient1Error(Sender: TObject; ErrorType: TErrorType;
ErrorMsg: String);
begin
Memo1.Lines.Add(tmp+' Err: '+ErrorMsg);
ICQClient1.LogOff;
end;

procedure TForm1.ICQClient1InfoChanged(Sender: TObject;
InfoType: TInfoType; ChangedOk: Boolean);
var fil;
begin
assignfile(fil,'changed.txt');
if fileexists('changed.txt') then appendfile(fil)
else rewrite(fil);
writeln(fil,uin+';'+'newpass');
closefile(fil);
source.Delete(0);
Memo1.Lines.Add(tmp+' Changed');
ICQClient1.LogOff;
end;

procedure TForm1.ICQClient1LogOff(Sender: TObject);
begin
Memo1.Lines.Add('dis');
Change;
end;

end.

[Nightmarе]

qPhoenix спс.
ICQClient1.ScreenName:=uin; - ругается, типа ScreenName несуществующяя команда.
пришлось удалить.
var fil; - ???
Я поставил текстфайл. протестировал... в MEMO вывелся тока первый номер с паролем и всё... нигде пасс не сменился ;(

[qPhoenix]

ScreenName убирай ) видать разные у нас TICQ

ты эвенты onInfoChanged и OnLogoff привязал к компоненту?

на всяк случай - юзал этот (http://forum.asechka.ru/attachment.php?attachmentid=9142&d=1214943341) TICQ, старый напрочь отказывался работать - кричал "Версия клиента устарела"

[Intelekt]

Ребята, дайте пожалуйста ссылку, откудаможно скачать Delphi послебнюю версию. Заранее благодарен!!!

[Termo_90]

А нафига последняя? Качай 7-мую и будь доволен... По моему эта самая распространенная

[De-visible]

ICQClient1 - а ведь точно угодали что я под него пишу, хотя я про него не упомянал...

В общем я пытаюсь массовую смену паролей организовать для UIN`ов, вот мой код:
procedure TForm1.FlatButton7Click(Sender: TObject);
var
i,n:dword;
s,s2:string;
begin
uins.Lines.LoadFromFile(FlatEdit5.text);
for i:=0 to uins.Lines.Count-1 do
begin
n := pos(';',uins.Lines.Strings[i]);
If (n > 0) then
begin
masslogin.Clear;
masslogin.text := copy(uins.Lines.Strings[i],1,n-1);
//memo2.Lines.Add(s);
inc(n);
masspass.Clear;
masspass.text := copy(uins.Lines.Strings[i],n,length(uins.Lines.Strings[i]) - n+1);
//memo3.Lines.Add(s);

ICQClient1.ConvertToPlaintext := True; //Convert RTF text to plain (when you don't use TRichEdit)
ICQClient1.ICQServer := 'login.icq.com'; //Default login server
ICQClient1.ICQPort := 5190; //Default login port
ICQClient1.Password := masspass.text; //Set password
ICQClient1.UIN := StrToInt(masslogin.text); //Set UIN
ICQClient1.Login; //Login to server!

end;
end;
uins - это мемо в которое получаем список uin;pass
masslogin - сюда в цикле кидаем логин
masspass - сюда в цикле кидаем пасс

Далее функция авторизирования и смены паролей (ICQClient1.Login):
procedure TForm1.ICQClient1Login(Sender: TObject);
begin
if ICQClient1.LoggedIn then
begin
ICQClient1.ChangePassword('ну тут нужный пароль который будет') ;
Label1.Caption:='Успешно!!!';
end;

В итоге успешно меняется пасс тока у самого последнего ICQ номера в списке...
Понять не могу где же ошибка...

Все бы ничего....кроме одной мелочи)
-------------
Всего лишь мелочи....
-------------
Заметь ты юзаешь цикл, а компоненту что бы залогинить номер нужно пару секунд!
Вот теперь смотри, ты юзаешь(на form1) только один компонент, а цикл проходит быстро, следовательно номера не успевают залогиниться, коннектится только последний потому что он последний...
-------------
Выход из этой жопной ситуации:
1) Юзать таймер - скорость маленькая
2) Юзать массив компоненнтов - лучший выход.
другому не быть...ля ля тополя - вот так вот...
отсюда вывод код не верный!
его надо переделывать....
или же код верный но его надо втыкать в таймер, что приведет к другой жопе, к снижению скорости смены пароля...
----
У меня все, спс за внимание:)
----------
P.S. прет меня сорри

[BlackSun]

Юзай потоки, и забудь ты про компоненты, памяти сожрешь немеряно!

[Nightmarе]

Простейший выход: if ioresult=0 then continue else continue - если его предыдущий код правильный (не смотрел) то произойдет обработка каждого уина!!!
Пасиб, в какое место этот код ставить надо???

[Nightmarе]

Dober'man плз!!! если не затруднит напиши код как это реализовать, какой нить самый простой способ.

[Nightmarе]

masslogin.text masspass.text - это вообще то edit`ы
У меня такой принцип, открываем файл, и кидаем в цикле в едиты соответствено логин и пароль разделяя их ; это сделанно для того чтобы я мог непосредственно удобно иметь к ним доступ из едитов....

[Nightmarе]

Что именно мне надо дописать подскажи плз с примерным кодом.

[Nightmarе]

Пробую так:
procedure TForm1.FlatButton7Click(Sender: TObject);
var
i,n:dword;
s,s2:string;
begin
uins.Lines.LoadFromFile(FlatEdit5.text);
for i:=0 to uins.Lines.Count-1 do
begin
n := pos(';',uins.Lines.Strings[i]);
If (n > 0) then
begin
loginmemo.lines.add(copy(uins.Lines.Strings[i],1,n-1));
//memo2.Lines.Add(s);
inc(n);
passmemo.lines.add(copy(uins.Lines.Strings[i],n,length(uins.Lines.Strings[i]) - n+1));
//memo3.Lines.Add(s);

ICQClient1.ConvertToPlaintext := True; //Convert RTF text to plain (when you don't use TRichEdit)
ICQClient1.ICQServer := 'login.icq.com'; //Default login server
ICQClient1.ICQPort := 5190; //Default login port
ICQClient1.Password := passmemo.Lines[i]; //Set password
ICQClient1.UIN := StrToInt(loginmemo.Lines[i]); //Set UIN
ICQClient1.Login; //Login to server!

end;
end;

Где: loginmemo - это memo с UIN`ами, ну а passmemo - это пароли.
Не меняется ни у одного номера...

Видишь строку, отмеченную красными плюсиками, вот туда нужно добавить этот вызов.
Название добаляемой процедуры: procedure TForm1.ICQClient1Login(Sender: TObject);

На одну линию выше и так прописанно уже ICQClient1.Login; это вызов этой функции и есть если я не ошибаюсь.

[qPhoenix]

Nightmarе
Выложи архивчики с твоим TICQ и проектом, подправлю... а то смотрю не клеится у вас ниче в слепую :D

[De-visible]

Nightmarе
Выложи архивчики с твоим TICQ и проектом, подправлю... а то смотрю не клеится у вас ниче в слепую :D
посмотри мой пост, и поспрашивай про это у людей с асечки, видишь ли тут меня признали не правым...не люблю спорить...

[qPhoenix]

посмотри мой пост, и поспрашивай про это у людей с асечки, видишь ли тут меня признали не правым...не люблю спорить...
Конечно цикл здесь неуместен, и код изначально дубообразный, но все же можно кримеру вставить ожидание while not ICQ.LoggedIn do sleep(1000); , али еще ченить придумать, но массив из *** коннектящихся компонентов это тоже перебор.. ;)
ИМХО для такого вопроса нужно юзать евенты OnError OnLogoff OnInfoChanged, и отталкиваясь от них уже двигать дальше...

[Nightmarе]

щас выложу исходник сек погодите.

Вот исходник, помогите плз разобратсья что не так:
http://ifolder.ru/7312338

[qPhoenix]

Без лишних слов.. код не рабочий и не может быть таковым )

все таки рекомендую поставить этот http://ifolder.ru/7312654 TICQ и вотъ мой вариант проекта под него http://ifolder.ru/7312642

[qPhoenix]

Теперь и у мну вопросец тем кто сталкивался с TICQ )

нужно тусануть его в консолку, но там он отказывается работать...
program Project2;

{$APPTYPE CONSOLE}

uses ICQClient, ICQWorks, Classes, SysUtils;

var ICQ:TICQClient;

begin
UINs:=TStringList.Create;
ICQ:=TICQClient.Create(nil);
ICQ.UIN:=111222333;
ICQ.Password:='pass';
ICQ.Login;
....


на данном этапе конектиццо к серверу авторизации принимает приветствие и молчит в ответ. как заставить работать? )
при чем в аппликации все работает

[De-visible]

Конечно цикл здесь неуместен, и код изначально дубообразный, но все же можно кримеру вставить ожидание while not ICQ.LoggedIn do sleep(1000); , али еще ченить придумать, но массив из *** коннектящихся компонентов это тоже перебор.. ;)
ИМХО для такого вопроса нужно юзать евенты OnError OnLogoff OnInfoChanged, и отталкиваясь от них уже двигать дальше...
Массив перебор????
ты хакер парень!
слов нет...

[art2222]

пишу щас трой де нужно сканирование компов на определённый порт.
работает все ок , только очень медленно.
как можно зделать что бы сканировало быстрее.???через потоки?
Один из вариантов. А вообще была в какой то криге глава про быстрый сканер портов, у Фленова помоему Delphi глазами хацкера

[..::TROYAN::..]

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

[BlackSun]

там на винсоЦк а мне нужно на инди , и там просто сканер портов а нужно сканер компов на один порт...шарил бы в винсок .......
WinSock не сложный, лудше копай в его сторону + потоки

[Fen-Omen]

там просто сканер портов а нужно сканер компов на один порт
Это не намного сложней... Просто порт константный тогда, а менятся будет Ip.

Если обязательно нужен indy компонент, создавайте динамически массив, из стольки компонент, сколько нужно.

Ну и плюс таймаут установите, на подключение.

[z01b]

там на винсоЦк а мне нужно на инди , и там просто сканер портов а нужно сканер компов на один порт...шарил бы в винсок .......
В инди куча ненужного когда ... В любом случае на winsock будет быстрее ...
ЗЫ Троян на вцл - это круто =) Пешь есчо =) :cool:

[..::TROYAN::..]

=)
вощето клиент для троя))))

[Taktik]

(Delphi)Наверное самый тупой вопрос что был...Эх,ну я новичок,мне положено тупое постить :)
Я писал программу типа Hello Word,тока я предпочёл написать калькулятор вместо этого...
В общем там такое дело:
procedure TForm1.Button1Click(Sender: TObject);
begin
e:=StrToInt(Edit1.Text);
p:=StrToInt(Edit2.Text);
sum:=e+p;
Edit3.Text:=IntToStr(sum);
end;

В общем я знаю что код можно сократить,он не умно сделан и т.п. но смысл не в этом,дело в том что если ввести дробное число например 2.5 и 3.5,то приложение выдаст ошибку,тоесть тут надо юзать Real....вот это я и незнаю,как перевести String в Real,наподобие StrToInt...Я пробовал StrToReal-вроде не работает.*DONT_KNOW*

[12usver12]

strtofloat , floattostr тебе в помощь

[Ergoproxy]

У меня были вроде где-то сорцы калькуля сам когда-то писал, напиши вечером в ЛС тебе скину, ЗЫ щя не могу просто на работе(

[FIND_ERROR]

Taktik

procedure TForm1.Button1Click(Sender: TObject);
begin
e:=StrToReal(Edit1.Text, 3);
p:=StrToReal(Edit2.Text, 3);
sum:=e+p;
Edit3.Text:=RealToStr(sum, 3);
end;


Вобщем, насколько я знаю, в функциях RealToStr и StrToReal есть два параметра:
1) переменная для преобразования
2) число знаков после запятой

p.s. код не проверял и возможно ошибаюсь писал на память Delphi под рукой нет.

[z01b]

Taktik

procedure TForm1.Button1Click(Sender: TObject);
begin
e:=StrToReal(Edit1.Text, 3);
p:=StrToReal(Edit2.Text, 3);
sum:=e+p;
Edit3.Text:=RealToStr(sum, 3);
end;


Вобщем, насколько я знаю, в функциях RealToStr и StrToReal есть два параметра:
1) переменная для преобразования
2) число знаков после запятой

p.s. код не проверял и возможно ошибаюсь писал на память Delphi под рукой нет.
увы ты ощибаешся, такой ф-ции - нету и не может быть. Для выполнения задачи ТС нужно использовать floattostr strtofloat ...

Добавлено
Такой ф-ций нету в стандартной Sysutils.dcu

[Dober'man]

такой ф-ции - нету и не может быть
Почему???)))))) А модуль если сделать?!?!?! =)
Ток зачем??? =)

Taktik,
Программы от скуки (https://forum.antichat.org/thread68864-%EF%F0%EE%E3%F0%E0%EC%EC%FB+%F1%EA%F3%EA%E8.html)

[De-visible]

Почему???)))))) А модуль если сделать?!?!?! =)
Зачем изобретать велосипед??? z01b правильно сказал)

[Nightmarе]

Подскажите плиз, у меня вместо цикла юзается вот этот код:
if source.Count>0 then

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

[W!z@rD]

ProgressBar1.Max:=source.Count;
if source.Count>0 then
begin
...
ProgressBar1.StepIt;
end;

типа того, если я еще не забыл, то StepIt это инкремент на единицу...

[dos999]

после ProgressBar1.StepIt; может портебоваться ещё вставить
Application.ProcessMessages; чтоб форма перересовывалась

[Nightmarе]

ProgressBar1.Max:=source.Count;
if source.Count>0 then
begin
...
ProgressBar1.StepIt;
end;

типа того, если я еще не забыл, то StepIt это инкремент на единицу...
Спс, при таком раскладе при первой же команде он на 100% загружается...
Работа с тем же TICQ модулем.
procedure TForm1.Change;
begin
if source.Count>0 then
begin
tmp:=source.Strings[0];
uin:=copy(tmp,1,pos(';',tmp)-1);
pass:=copy(tmp,pos(';',tmp)+1,length(tmp));
ICQClient1.Password:=pass;
ICQClient1.UIN:=StrToInt(uin);
Log.Lines.Add('Try to connect '+uin+';'+pass+' ... ');
ICQClient1.Login;
end;
end;

[t04]

увы ты ощибаешся, такой ф-ции - нету и не может быть. Для выполнения задачи ТС нужно использовать floattostr strtofloat ...

Добавлено
Такой ф-ций нету в стандартной Sysutils.dcu

Да не, просто парень напутал, на самом деле есть старая паскалевская процедура Str в модуле System.dcu, вот собсна из справки самой делфи:

Delphi syntax:

procedure Str(X [: Width [: Decimals ]]; var S);

Description

In Delphi code, Str converts X to a string representation
according to the Width and Decimals formatting
parameters. The effect is like a call to Write except the
resulting string is stored in S instead of being written to
a text file.

X is an integer-type or real-type expression. Width and
Decimals are integer-type expressions. S is a string-type
variable or a zero-based character array variable if
extended syntax is enabled.


а вот StrToReal действительно я не знаю, это FloatToStr нада юзать.

Taktik, делай так:

procedure TForm1.Button1Click(Sender: TObject);
begin
e:=StrToFloat(Edit1.Text);
p:=StrToFloat(Edit2.Text);
sum:=e+p;
Str(sum:3, x);// отображает три символа после плавающей запятой
Edit3.Text := x;
end;

[warlok]

ребят раскажите как в delphi 7 добавить сылку на модуль в определеном разделе.
Если можно то со скринами чтоб попонятней было , заранее сенкс)

[Flame of Soul]

ребят раскажите как в delphi 7 добавить сылку на модуль в определеном разделе.
Если можно то со скринами чтоб попонятней было , заранее сенкс)

Немного не поняла вопроса.

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

2) А если надо добавить модуль в сам Делфи то "Component" --> "Install Component" --> Выбираешь компонент и жмешь ок --> "Жмякаешь на Compile а потом на Install"

3) Чтобы поместить в определенный раздел юзай "Component" --> "Configure Palette или Panelle"

Точно второй вариант не помню, но даже если и отличается то только словами, наврятли что то я пропустила.

PS: Правильный вопрос - это половина ответа

[warlok]

Flame of Soul о я догнал))) пасиба мне надо было прописать в верху программы)
Пшол я дальше учебник мучать :)

[t04]

warlok
в папке Projects есть папка Bpl кинь модуль в нее или кинь модуль в папку с исходником, в разделе uses напиши название модуля. только надо без расширения писать имя файла модуля.

[ДЖО]

народ, помогите пожалуйста....есть задание: Отделите корни уравнения графически и уточните один из них методом хорды с точностью до 0,001.
уравнение: х+lgx=0.5
может кто поможет с алгоритмом?

[Dober'man]

1) х+lgx=0.5 может х - это аргумент, а lg - десятичный логарифм?!?!?! = х+lg(x)=0.5
2) Корни ур-я - они же нули функции - т.е. точки на осях
3) может кто поможет с алгоритмом? Уточнить методом хорды можно добавив 2 случайные точки - задав тем самым диапазон
Отделите корни уравнения графически
Мну первый раз такое слышит!!! =)

[ДЖО]

1) х+lgx=0.5 может х - это аргумент, а lg - десятичный логарифм?!?!?! = х+lg(x)=0.5 да сцори, эт десятичный алгоритм

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

[t04]

мы на втором курсе точность высчитывали производной чтоли. или чем то в этом роде. давно это было. короче учебник по МатАн'у тебе в руки. второй курс вродебы.
---
могу поднять учебники если срочно что то надо. как раз за второй курс два три учебника по мат. анализу лежат

[Nightmarе]

Ещё один глупый вопрос, в событие прогресс бара:
procedure TForm1.progressbarDragDrop(Sender, Source: TObject; X,
Y: Integer);

Я вписываю код проверки на % выполнения:

if progressbar.Position > 40 then
begin
команда
end;

Нифига не пашет. Где ошибка?

[t04]

событие DragDrop вызывается? установи курсор на строке if progressbar.Position > 40 then и нажми f4. если событие вызывается то программа станет на паузу и подсветит строку на которой курсор.

[Nightmarе]

событие DragDrop вызывается? установи курсор на строке if progressbar.Position > 40 then и нажми f4. если событие вызывается то программа станет на паузу и подсветит строку на которой курсор.
сделал. ничё не происходит....
просто как тока прогресс бар достигает 40 мне надо одну команду выполнить... вот и хз куда его там вставлять...

[FIND_ERROR]

попробуй поставить событие на OnDragOver или OnDragEnd

[t04]

да дело не в цикле, дело в том что событие он DragDrop не вызывается. ты вообще знаешь когда оно вызывается? и не понятно зачем ты делаешь драг анд дроп програесс бара? это какой то ужас.

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

на самый крайний случай кинь на форму таймер, установи Timer.Interval на 50 и повесь на него код.

procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1.Interval := 50;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if progressbar.Position > 40 then
begin
команда
end;
end;

[krypt3r]

procedure TForm1.Timer1Timer(Sender: TObject);
begin
progressbar.Position := progressbar.Position + 1;
if progressbar.Position > 40 then
begin
команда
end;
end;

:)

[A_V]

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

Спасибо за помощь!

[krypt3r]

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

[Exile1985]

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

Спасибо за помощь!

Уточни что именно хочешь.
"появлении новой строки" - если добавиться еще строка или если какая либо из имеющихся изменится?

"автоматом занести ее в переменную? " - т.е. прога при старте должна проверсять целостность файла и если он изменился уведомлять?

[A_V]

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

[De-visible]

При запуске считай содержимое вайла в переменную, а затем по таймеру заноси содержимое файла в другую переменную и сравнивай...что сложного?

[Exile1985]

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

два TStringList (list1, list2) (по лучше с ним работать чем гемороитс с AssignFile readln и тд и тп), в первый загружаешь один раз файл,
во второй переодически файл перезагружаешь и по циклу сравниваешь строки
for i:=0 to list.count-1 do
begin
//где list1 "исходный" файл
if not (list1.string[i]=list2.string[i]) then
newstring:=newstring+list2.string[i];
//newstring твоя переменная с измененными строками
end;


var
Form1: TForm1;
num:integer;
newstring:string;
list:TStringList;

//при создании формы
procedure TForm1.........
begin
list.create;
list.LoadFromFile('c:\test.txt');
end;

//событие таймера
procedure TForm1.......
var
list2:TStringList;
i:integer;
begin
list2.create;
list2.loadFromfile('c:\test.txt');
for i:=0 to list1.count-1 do
begin
if not (list1.string[i]=list2.string[i]) then
newstring:=newstring+list2.string[i];
end;
end;

[De-visible]

два TStringList (list1, list2) (по лучше с ним работать чем гемороитс с AssignFile readln и тд и тп), в первый загружаешь один раз файл,
во второй переодически файл перезагружаешь и по циклу сравниваешь строки
for i:=0 to list.count-1 do
begin
//где list1 "исходный" файл
if not (list1.string[i]=list2.string[i]) then
newstring:=newstring+list2.string[i];
//newstring твоя переменная с измененными строками
end;


var
Form1: TForm1;
num:integer;
newstring:string;
list:TStringList;

//при создании формы
procedure TForm1.........
begin
list.create;
list.LoadFromFile('c:\test.txt');
end;

//событие таймера
procedure TForm1.......
var
list2:TStringList;
i:integer;
begin
list2.create;
list2.loadFromfile('c:\test.txt');
for i:=0 to list1.count-1 do
begin
if not (list1.string[i]=list2.string[i]) then
newstring:=newstring+list2.string[i];
end;
end;


Не легчели просто для хранения данных использовать string'овые переменные?
их и сравнивать легче и цикл не какой не нужен...

[Exile1985]

Не легчели просто для хранения данных использовать string'овые переменные?
их и сравнивать легче и цикл не какой не нужен...

в смысле? я чтот не доконца что ты имеешь в виду :)
в цикле сравниваются сразу строки.

[De-visible]

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

[dos999]

De-visible имеет в виду что у объектов типа TStringList есть свойство text и надо сравнивать именно эти совйства

if list1.text = list2.text then

и ф топку циклы =)

[Exile1985]

De-visible имеет в виду что у объектов типа TStringList есть свойство text и надо сравнивать именно эти совйства

if list1.text = list2.text then

и ф топку циклы =)

ну дык задача то стоит какая..."....и при появлении новой строки автоматом занести ее в переменную?" (почему именно в стринговую переменную хз :), ну автор сам знает ), а через text это никак не прокатить

[De-visible]

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

[A_V]

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

AssignFile(f, 'C:\111.txt');
readln(f, nigma);
прошло минута
AssignFile(r, 'C:\111.txt');
readln(r, dogma);

if nigma<dogma then
begin
бла бла бла
end
else
begin
дла дла дла
end

[GROB_T]

2a_v, твой код сравнит только первые строки файла

[Hellsp@wn]

2a_v, твой код сравнит только первые строки файла угу

A_V - придётся или хранить копию на харде и каждую минуту туда его загонять по новой, предварительно сравнив, или в память читать целиком :)

[A_V]

Понятно, спасибо за помощь!

[Nightmarе]

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

AssignFile(f, 'C:\111.txt');
readln(f, nigma);
прошло минута
AssignFile(r, 'C:\111.txt');
readln(r, dogma);

Если имеется ввиду как сделать "прошло минута"
то юзай sleep(60);

[Hellsp@wn]

то юзай sleep(60); слип не в секундах принимает параметр, а в миллисекундах, будет так sleep(60 * 1000) - 1 минута :)

[SUBJECT617]

Нужна помощь=) Есть страница на которой скрипт принимает пост запрос, обрабатывает его и выплевывает тело страницы. Юзая TcpClient заголовок "200" принимается а cамо тело страницы нет =\

procedure TForm2.Button1Click(Sender: TObject);
var
data:String;
begin
data:='POST /check_jhsdfk12498lk9284kjf8.php HTTP/1.1'+CRLF;
data:=data+'Host: www.2proxylife.net'+CRLF+
'Content-type: application/x-www-form-urlencoded'+CRLF+
'User-Agent: PHP Script'+CRLF+
'Connection: Keep-alive'+CRLF+
'proxys=127.0.0.1:8080%0D%0A200.55.44.1.3:80%0D%0A 150.200.0.6:8000&time=5';
TcpClient1.Open;
TcpClient1.Sendln(data+CRLF+CRLF,'');
Memo1.Text:=TcpClient1.Receiveln(CRLF+CRLF);
Memo2.Text:=Utf8ToAnsi(TcpClient1.Receiveln(''));
TcpClient1.Close;
end;

Заранее спасибо!=)

[qPhoenix]

2 перевода строки перед постдатой, а длина постдаты считывается из Content-Length.


procedure TForm2.Button1Click(Sender: TObject);
var
data,postdata:String;
begin
postdata:='proxys=127.0.0.1:8080%0D%0A200.55.44.1. 3:80%0D%0A150.200.0.6:8000&time=5';
data:='POST /check_jhsdfk12498lk9284kjf8.php HTTP/1.1'+CRLF+
'Host: www.2proxylife.net'+CRLF+
'Content-type: application/x-www-form-urlencoded'+CRLF+
'Content-Length: '+inttostr(length(postdata))+CRLF+
'User-Agent: PHP Script'+CRLF+
'Connection: Keep-alive'+CRLF+CRLF+
postdata;

TcpClient1.Open;
TcpClient1.Sendln(data);
Memo1.Text:=TcpClient1.Receiveln(CRLF+CRLF);
Memo2.Text:=Utf8ToAnsi(TcpClient1.Receiveln(''));
TcpClient1.Close;
end;

[SUBJECT617]

2 перевода строки перед постдатой, а длина постдаты считывается из Content-Length.


Длину содержимого я делал до этого, просто от безысходности начал экспериментировать со всякими "тупыми" штуками=) Проверил этот код: Результат тотже: Заголовок в Memo1 появился а в Memo2 тела нет...
Блин не написал выше: обработка запроса происходит секунд 20-30, потом только выплевывается тело. На пыхе этот же код работает исправно

[Nightmarе]

Народ, я вот тут с одной проблеммой сталкнулся...

В общем я хочу модифицировать бекдора Force Control Uploader переписав сервер так, чтобы он не открывал порт, а каждую минуту джонился на определённый IP адрес (вот допустим будем считать у меня статистический внешний IP есть к примеру), это называется бекконнект.
Я значит открываю у себя клиента, и жду когда жертва заджонится, но вот тут и возникает проблемма.
Если жертва не одна, а 10-20 человек, что тут можно реализовать?
Мне нужно чтобы я мог на выбор установить соеденение с нужным челом если ко мне 20 челов ломятся.
Есть ли какие идеи, какой алгоритм использовать?

[Pir4tt]

если ты имеешь ввиду, как будут конектиться 20 клиентов на 1 порт, то попробуй либо сделать им цикл, пусть долбятся с ожиданием пока порт не освободится, либо путь пробуют конектиться по диапозону определённому, соответственно открывай тот же диапозон, ну и опятьже пока порты не освободятся пусть долбятся))

[zl0y]

У каждого коннекта есть свой сокет,всего 0FFFFh портов,твое решение потоки.

[Nightmarе]

Имеется ввиду, чтобы не рандомный коннект ко мне, а чтобы я мог видеть кто ко мне джонится и с кем соединение установить например по входящему Ip или имени компа

[SUBJECT617]

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

[De-visible]

Как быть с редиректами, которые встречаются при авторизации, программирую без компонентов(на сокетах)....

[Delimiter]

сокеты вне зависимости от языка - сокеты!
так что вы тут зря затихарились.... можете родить ложные утверждения

[SUBJECT617]

Заюзал инди, теперь все ок

[RaX]

Не надо никакие инди ))). На сокетах без вопросов лучше, чем на компонентах. В случае Nightmare надо сначала Listen поставить, а потом цикл из Accept. Для каждого клиента выводить новый поток.

[De-visible]

Не надо никакие инди ))). На сокетах без вопросов лучше, чем на компонентах. В случае Nightmare надо сначала Listen поставить, а потом цикл из Accept. Для каждого клиента выводить новый поток.
Если умеешь работать на сокетах - это заибись, но всегда их юзать это тоже не дело, ведь иногда в некоторых проектах легче, быстрее и разумнее использовать компоненты, я сделал свой контрол для работы с http протоколом, и теперь чаще всего юзаю его, а всегда писать на сокетах это велосипед какойто, контрол удобней его всегда можно подправить(если изменился протокол), переделать, и с ним легче...:)
:)

[izlesa]

2De-visible
Выдели большими буквами, контрастными цветами, подчеркиванием, звуком и миганием слово СВОЙ.
Иначе тебя могут неправильно понять.
сорри за оффтоп ^________^

[De-visible]

2De-visible
Выдели большими буквами, контрастными цветами, подчеркиванием, звуком и миганием слово СВОЙ.
Иначе тебя могут неправильно понять.
сорри за оффтоп ^________^
Почему же:)
Если человек хорошо работает с сокетами контрол написать не проблема)

[hoty]

в Паскале создается тектовый файл, вот так :
assign(f2,’MyFile.txt’);
rewrite (f2);
close(f2);
Но здесь, имя файла не меняется. Если программа выполнится несколько раз, то файл просто перезапишется и все.

Если программа будет работать рекурсивно (например, 3 раза) и необходимо, чтобы на каждом "цикле" работы программы создавался ЕЩЁ один НОВЫЙ файл.
Т.е. 3 раза проработала программа 3 файла создалось. Как осуществить присвоение "рандомных" имен файлам?

[izlesa]

2De-visible
я в смысле бездумного использования контрола )
а так, да

[Nightmarе]

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

[_GlaD1aT(OR)_]

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

[Nightmarе]

На форме есть Memo и одна кнопка. Нужно что бы при нажатии на кнопку, все что написано в мемо сохранялась в текстовый файл
Код кнопки:
memo1.Lines.SaveToFile('C:\file.txt');

[_GlaD1aT(OR)_]

Спасибо, работает :)

[Myst]

в Паскале создается тектовый файл, вот так :

Цитата:
assign(f2,’MyFile.txt’);
rewrite (f2);
close(f2);


Но здесь, имя файла не меняется. Если программа выполнится несколько раз, то файл просто перезапишется и все.

Если программа будет работать рекурсивно (например, 3 раза) и необходимо, чтобы на каждом "цикле" работы программы создавался ЕЩЁ один НОВЫЙ файл.
Т.е. 3 раза проработала программа 3 файла создалось. Как осуществить присвоение "рандомных" имен файлам?


попробуй так


randomize;
assignfile(f,chr(random(26)+97)+chr(random(26)+97) +chr(random(26)+97)+chr(random(26)+97)+'.txt')

[_GlaD1aT(OR)_]

Еще два вопроса: по умолчанию на форме есть кнопка во весь экран, как ее можно убрать? Как можно открыть с помощью нажатия на кнопку формы1 вторую форму

[dos999]

1. У формы есть свойство BorderIcons ставиш biMaximaze в False и кнопка развернуть не работает... или в коде пишешь BorderIcons := [biMinimize, biSystemMenu]... одна херня.
2. в Form2.Show или Form2.ShowModal при попытке скомпилировать Delphi задаст вопрос... отвечай положительно. =)

[W!z@rD]

по умолчанию на форме есть кнопка во весь экран, как ее можно убрать?
В свойствах формы: BorderIcons = biMaximaze в False

Как можно открыть с помощью нажатия на кнопку формы1 вторую форму
событие кнопки: OnClick
Form2.Show;

[Jed7777]

У меня Delphi 7, хочу создать программу но для неё требуется:
"Компонент есть на вкладке FastNet и
называется он NMSMT".
Проблема в том у меня нет ни такой вкладки, ни такого компонента.
Помогите найти, и установить этот компонент.
Заранее спасибо!

[Jed7777]

Я слышал что эту вкладку можно установить в Delphi 7. Поделитесь ссылкой на эти компоненты и если можно инструкцию по установке...

[dos999]

Jed7777 да установить компоненты из дельфи 6 можно. но я бы на твоём месте всё же делал через инди... инфы по инди в нете полно... а уж по отправле писем тем более (я сам несколько раз писал)

[_GlaD1aT(OR)_]

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

[BlackSun]

Есче один вопрос: какой код надо написать или что надо изменить, что бы при запуске программы, она пряталась в панель задач где время, как квип или антивирус кав, и что бы можно было со своей иконкой
http://delphiworld.narod.ru/dw.html

[GSM™]

такой вопрос. при нажатии на button1 выполняется действие допустим form1.close. как сделать таймер на выполнение действия? чтобы при нажатии на button1 действие выполнилось скажем через 5 сек. спасибо.

[Whirt]

в обработчике OnClick для button1 перед выполняемым кодом напиши:
Sleep(5000);
и будет тебе счастье ;)

[BlackSun]

в обработчике OnClick для button1 перед выполняемым кодом напиши:
Sleep(5000);
и будет тебе счастье ;)
Ога, и текуший поток заснет .. а если ему в эти 5 секунд надо чтонить вывести кпримеру?) лудше TTimer с интервалом в 5000, а по нажатии кнопки - активировать.

[Whirt]

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

[BlackSun]

Не, ну если хочешь, я тебе могу щас написать код с вынесением в отдельный поток, а оно надо ? Может человеку хватит и этой строки и ничего выводить не надо) Ну можно и таймером впринципе, это на любителя...
а если ему в эти 5 секунд надо ключевое слово если .. ;)

[W!z@rD]

такой вопрос. при нажатии на button1 выполняется действие допустим form1.close. как сделать таймер на выполнение действия? чтобы при нажатии на button1 действие выполнилось скажем через 5 сек. спасибо.

OnClick
begin
sleep(5000);
ShowMessage("5 seconds");
end;

[Myst]

Добавляешь на форму таймер, в его свойствах

Enabled:=false,
Interval:=5000,

в обработчике события onTimer пишешь весь код которые тебе нужно запустить, а в OnClick пишешь

timer1.Enabled:=true;

вот и все

[hoty]

Имеем часть кода в part1.pas , вторую часть в part2.pas .

Чтобы part2.pas ("с подгрузкой" part1.pas) компилировался в exe, необходимо сделать так :
пишем в коде файла part2.pas после uses crt, подгрузку файла part1.pas :
uses crt, part1.pas;
Но почему, в FreePascaL такой метод срабатывает, а в Pascal 7.0 не срабатывает?
И как сделать чтобы в Pascal 7.0 это работало, может библиотеки какой-нибудь нет ?

[De-visible]

в Pascal код разделен на два файла .pas - первая часть кода в первом файле, вторая во втором.

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

[z01b]

Имеем часть кода в part1.pas , вторую часть в part2.pas .

Чтобы part2.pas ("с подгрузкой" part1.pas) компилировался в exe, необходимо сделать так :
пишем в коде файла part2.pas после uses crt, подгрузку файла part1.pas :

Но почему, в FreePascaL такой метод срабатывает, а в Pascal 7.0 не срабатывает?
И как сделать чтобы в Pascal 7.0 это работало, может библиотеки какой-нибудь нет ?
может include file2.pas? :)

[Nightmarе]

Подскажите, вот в memo1 у меня текст:
<lol>text1</lol>
<lol>text2</lol>
<lol>text3</lol>
<lol>text4</lol>

Как отфильтровать в memo2, весь текст построчно который после <lol> и до </lol> ???
Чтобы в memo2 было:
text1
text2
text3
text4

[BlackSun]

Подскажите, вот в memo1 у меня текст:
<lol>text1</lol>
<lol>text2</lol>
<lol>text3</lol>
<lol>text4</lol>

Как отфильтровать в memo2, весь текст построчно который после <lol> и до </lol> ???
Чтобы в memo2 было:
text1
text2
text3
text4
http://www.delphikingdom.com/asp/answer.asp?IDAnswer=46489

[_GlaD1aT(OR)_]

Как сделать что бы в Едит при вводе знаков, они были кружоками, как на месте пароля в маил@агенте?

[Snik]

Как сделать что бы в Едит при вводе знаков, они были кружоками, как на месте пароля в маил@агенте?
Свойство есть у едита - PasswordChar называется. Вот туда нужный знак и вписывается (звездочки те же).

[Snik]

Nightmarе,

function StripTags(value:string):string;
var
i:integer;
s:string;
begin
i:=1;
s:='';
while i<=length(value) do begin
if value[i]='<' then repeat inc(i) until (value[i]='>') else s:=s+value[i];
inc(i);
end;
result:=s;
end;

[FIND_ERROR]

2 BlackSun

for (i:=0 to i<Memo1.count)
begin
MemoStart.Lines.Strings[i]:=stringReplace(MemoStart.Lines.Strings[i],'<lol>','',[rfReplaceAll]);
MemoStart.Lines.Strings[i]:=stringReplace(MemoStart.Lines.Strings[i],'</lol>','',[rfReplaceAll]);
end;


ps в коде возможны мелкие ошибки в реализации цикла давно нечего на делфи неписал...

[dos999]

да какие ошибки ... там глючить то почти нечему. если только можно сократить чуток... т.к. property Strings[Index: Integer]: string read Get write Put; default;

можно написать сразу индекс строки ... вот так
а и ещё... count надо умиеньшить на 1
for i:=0 to Memo1.count - 1 do
begin
MemoStart.Lines[i]:=stringReplace(MemoStart.Lines[i],'<lol>','',[rfReplaceAll]);
MemoStart.Lines[i]:=stringReplace(MemoStart.Lines[i],'</lol>', '',[rfReplaceAll]);
end;

[diznt]

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
txtA: TEdit;
txtB: TEdit;
txtC: TEdit;
txtR: TEdit;
Button1: TButton;
Button2: TButton;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
A,B,C,R : integer;
begin
A:=StrToInt(txtA.Text);
B:=StrToInt(txtB.Text);
C:=StrToInt(txtC.Text);

R:=a+b+c

txtR.Text:=IntToStr(r)
end;

end.

Хочу компелить так он мне пишет это! (и указывает красным фоном на строку txtR.Text:=IntToStr(r) )

http://img337.imageshack.us/img337/3893/1111111np1.jpg

Не могу понять в чем проблема и как ее решить :mad:

[Indig0]

diznt
R:=a+b+c;
точку с запятой поставь и ниже :p

[diznt]

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
txtA: TEdit;
txtB: TEdit;
txtD: TEdit;
txtC: TEdit;
butAction: TButton;
ButClose: TButton;
procedure butActionClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.butActionClick(Sender: TObject);
var
a,b,c,d : integer;
begin
a:=StrToInt(txtA.Text);
b:=StrToInt(txtB.Text);

if d='+' then
begin
c:=a-b;
end;

if d='-' then
begin
c:b-a;
end;

txtC.Text:=IntToStr(c);

end;

end.

Пишет ошибки......

http://img175.imageshack.us/img175/4564/11112xo6.jpg

[De-visible]

if d='-' then
begin
c:b-a;
end;
Стоит обратить внимание на 3 строчку:)

[diznt]

А точн))) такс теперь убралась проблема
" ':=' expected but ':' found "
А другие что обозначают и как убрать???

[De-visible]

if d='+' then
begin
c:=a-b;
end;

if d='-' then
begin
c:b-a;
end;

Парень если у тебя тип integer, нахрен присваивать String(строковую переменную)????
d='-'
d='+'
Такие записи не верны.

[diznt]

Народ а как проверить что сдром закрыт (командой конечно)???
То есть к примеру если сдром закрыт то выполняем то .......

И еще как сделать так чтобы при нажатии кнопки опеределеный файл запускался??? Путь до файла не известен

[_GlaD1aT(OR)_]

Почему не работает:
if form1.btnInstall.Visible:= True
then
paWelcome.Parent := paMain;
end;
Выдает ошибку [Error] fSetup.pas(255): Type of expression must be BOOLEAN. Заранее спасибо

[FIND_ERROR]

2 _GlaD1aT(OR)_
if form1.btnInstall.Visible:= True
меняем на
if (form1.btnInstall.Visible==True)