Просмотр полной версии : [Delphi]/[Pascal] Задай вопрос, получи ответ
Progeras
04.05.2009, 07:33
Вопрос по delphi.
Суть заключается в том, чтобы программа
1.Добавила новую секцию в exe файле.
2.Записала туда какой-то код(он будет запрашивать пароль).
3.Сменила точку входа(Entry point) на адрес добавленного кода.
4.В конце добавленного кода поставила JMP на оригинальную точку входа(OEP).
Теперь пояснение.
Конечно сразу можно подумать, что я пишу вирус. Я знаю, что этим методом
пользуются вирусы для заражения файлов. Но на самом деле я пишу защиту для своих програм.
Дело в том, что есть у меня знакомый человек, который любит присваивать себе мои программы.
Я не хочу использовать уже готовые программы, мне нужна своя.
З.Ы. Не надо мне присылать смещения в PE Header'е и статьи на эту тему(про смещения).
Я их прекрасно знаю, но не могу их примменять, поэтому жду от вас исходники,которые выполняют
эти операции. Как добавлять новые секции я почти разобрался, а вот с EP я сел в яму.
Гугл весь перерыл, но натыкался только на вирусы написанные на ASM'е, но они мне не нужны.
З.Ы. З.Ы. За быстрый ответ с хорошим исходником, можете заработать вознаграждение
на мобильник(50 или 100 руб.).
Flame of Soul
04.05.2009, 11:09
Progeras - Вы шутник однако, Вы просите исходники со сменой точки входа, при
том что Вы ничего не сделали для людей сидящих здесь? Вы думаете такой исход
ник на дельфинчике стоит 50-100 рублей? Мне кажется это слишком самонадеянно.
Ну а если по теме то в PE-файлах описывается специальное поле в PE-заголовке,
в котором лежит RVA-(относительный виртуальный адрес) EP, с которого как бы и
начинается выполнение. но мы то знаем, что Entry Point) выполняется не первой,
а последней. До нее система загружает все статик библиотеки и выходят на испо
лнение через Dllmain. TLS-k’и также получают управление до выполнения EP, кот
орую Вы собираетесть сменить, только не понятно какой именно участок вашего ко
да потеряет управление и EP будет некому вызывать, так как она будет указывать
неизвестно на какой код. Вот только Вы не уточняете кто у Вас этот "Маша расте
ряша", толи Dllmain или может быть TLS-callback.
#*************************************************
#define PE_off 0x3C // PE magic word raw offset
#define EP_off 0x28 // relative Entry Point filed
offset
BYTE* GetEP()
{
static BYTE* base_x, *ep_adr;
static DWORD pe_off, ep_off;
char buf [_MAX_PATH];
// obtain exe base address
GetModuleFileName(0, buf, _MAX_PATH);
base_x = (BYTE*) GetModuleHandle(buf);
pe_off = *((DWORD*)(base_x + PE_off));
ep_off = *((DWORD*)(base_x + pe_off + EP_off));
ep_adr = base_x + ep_off; // RVA to VA
return ep_adr;
}
#*************************************************
Это простейший пример GetEP(), но только боевая функция чуть чуть посерьезнее,
так как осуществляет такую огромную кучу всяких проверок. Но концепция приведе
нная выше правильная. И конечно же в данном случае Вы спрячете много чего от
отладчика, но бряк на ntdll, несработает, нет, нет, и еще раз нет, он пойдет
лесом, так как адрес EP у нас совершенно другой. Да да, самый яркий пример, это
когда парень в воскресенье подрывается с кровати и говорит, что емуу надо сроч
но на работу, а потом не звонит. если быть подробнее, то ОС никак не информиру
ет отладчик о передаче управления на EP и отладчик должен париться над этим сам
остоятельно, а не просить об этом на форуме, но так как отладчик идет лесом, я
и пишу свой обоснованный ответ, почему он туда пошел. Дизасемблирование тут то
же мало поможет так как они(дизассемблеры) сразу начинают с ЕР. а вот тут-то
без определения реальной ЕР не куда! Некоторые вири используют довольно хитрый
трюк, они как акробаты в цирке прыгают jump из TLS-callback’а, то есть, на сам
ом то деле они выполняют TLS-callback но без возврата управления. И в итоге на
ша любимая, красивая, оригинальная(это я про себя) ЕР идет к бабушке с пирожка
ми лесом и могут эти пиражки содержать что угодно (это я про ЕР). НО!!! НО!!!!
Начиная с XP, системный загрузчик выполняет ряд проверок (дабы не дать мистеру
смиту заразить матрицу)- и файлы, с точкой останова которые вылетают за преде
лы страничного образа, он просто поылат и не грузит в память. Хотя тут все ут
рированно, даже если бы он их грузил,то любой более менее нормальный авер, за-
рычал бы на вашу безобидную антиотладочную систему, так как такая ЕР уж очень
косо на него смотрит. Ну и какой смысл безобидную программу выдавать за вирус?
Тогда конечно же лучше всего закинуть ЕР в безобидный код, а из TLS-callback’а
совершить переход на тело.
#*************************************************
EntryPoint:
XOR EAX, EAX
PUSH EAX
CALL d, ds:[ExitProcess]
…
PassowrdBody:
…
…
…
TLS_Callback1:
ADD d, ds:[ESP+magic_offset], offset VirusBody
— offset EntryPoint
RETN 0Ch
#*************************************************
А вот после такого в США выбирают в президенты наштх афроамериканских друзей.
Я не рассистка конечно же, но просто в первом случае мы бы имели позорный jump
из TLS-callback’а. который бы потом пришлось маскировать с помощью математичес
ких преобразований, но целевой адрес перехода декодируется однозначно и палит.
А во втором случае TLS-callback добавляет какое-то значение к некоторой ячейке
памяти, лежащей в области стека, и возвращает управление системе. Человек с от
ладчиком чисто теоретически может трассировать миллионы тонн машинных инструк
ций, ответственных за инициализацию файла. Он может даже дождаться момента пе
редачи управления на точку входа или хотя бы область памяти, не принадлежащую
системе, а находящуюся в границах PE-файла или одной из динамических библиотек.
И тогда товарищ с удивлением обнаружит, что точка входа каким-то магическим об
разом ушла в запой! Вот только трассировать придется долго. А Аверы ничего на
скажут вашей маленькой приблуде, так как они не могут трассировать на живой ОС.
Откуда им знать, что именно находится в данной конкретной ячейке памяти? А что,
собственно говоря, там находится и как оно туда попадает?
Только стоить это будет не 50 и не 100 рублей.
KaZ@NoVa
04.05.2009, 11:39
Как можно при открытии Form2 забрать значение из Form1
Чтобы: Form2.Label2.Caption = Form1.Edit1.Text
легко. В разделе uses пишешь название юнита, содержащего эту форму.
Например, если она находится в Unit1 пишешь
uses Unit1.dcu;
вот и всё=) :rolleyes:
2 Progeras там шутк 50 строк кода на асме для заражения шелкодом. И еще дохера строк шелкода который будет спрашивать пароль. ибо гемор с созданием формамы на API большой. При том что код должен быть позиционно независимый.
Добавление новой секции не всегда правильный код. При сливании секций при компиле в Си бывает получается что места нету под вставку новой таблицы для своей секции. (пример - калькулятор)
Кисто инфектор - как раз и будет стоить копейки, там нет ничего сложного, а вот сам шелкод - никто ипаться не будет из-за этого, т.к. возьни много.
у DBGrid не появляется горихонтальный скролбар.. хотя даные не все на экране... как его "включить" ? )
в FormCreate попробуй установить свойство показа скрол бара.
SetScrollRange(DBGrid1.Handle,SB_HORZ,0,100,true);
в FormCreate попробуй установить свойство показа скрол бара.
SetScrollRange(DBGrid1.Handle,SB_HORZ,0,100,true);
неа, не помогло(
Tapaceuka
05.05.2009, 17:21
PASCAL
Вот задание:Билет называют «счастливым», если в его номере сумма первых трех цифр равна сумме последних трех. Подсчитать число тех «счастливых» билетов, у которых сумма трех цифр равна 13. Номер билета может быть от 000000 до 999999.
Вот что я пока написал:
program tt;
const a=001;b=009;
var m:array[a..b] of integer;i,c:integer;
begin
for i:=a to b do m[i]:=i;
for i:=a to b do
write(m[i]);
end.
Всё, сам берёт и заполняет массив и выводит его. Но как зделать чтобы число 001 не преабразовывалось просто в однёрку ?
если я не ошибаюсь и правильно понял задачу (посчитать кол-во счастливых билетов, у которых сумма первых трёх цифр равна сумме последних трёх цифр и равна 13), то ответ это..
а нет. ошибаюсь. ща поправлю
((C из 15 по 2) - 3*(С из 4 по 1 + C_3 по 1 + C_2 по 1 +C_1 по 1))^2 = 75^2
вот так правильно )
Подскажите пожалуйста, как сделать что бы при запуске программы, она сразу сворачивалась трей?
De-visible
05.05.2009, 20:34
Подскажите пожалуйста, как сделать что бы при запуске программы, она сразу сворачивалась трей?
Ты ппц спросил....
Для начала, тебе надо научиться работать с треем), ну а далее затолкать функцию/код (сворачивания в трей) в какое нить событие.
Ответ на уровне твоего вопроса :)
юзай гугл!!!!!!!
Delphi World (5005 статей по Delphi) статья "Иконка на TrayBar - пример"
Там скрытие в трей(HideItemClick(Self)) делается при сворачивании формы.
Сделай ты еще глобальную переменную. типа flag=false;
и при событии OnPaint если flag=false пряч форму HideItemClick(Self);
и делай flag=true; Это сделает так чтобы при первой прорисовке прожка скрылась. Хотя можно помудрить и в dpr файле чтобы форма не показывалась с самого начала и при OnCreate вставляешь HideItemClick(Self) но нужно тогда убрать скрытие формы
2 Zitt попробуй переопределить методы этого компонента с созданием нового но с обработкой onpaint где будет показываться скролбар.
type
TScrollBarDBGrid = class(TDBGrid)
protected
procedure Paint; override;
end;
procedure register;
implementation
procedure register;
begin
RegisterComponents('Samples', [TScrollBarDBGrid]);
end;
procedure TScrollBarDBGrid.Paint;
begin
SetScrollRange(Handle, SB_VERT, 0, 100, false);
SetScrollRange(Handle, SB_HORZ 0, 100, false);
или
ShowScrollBar(Handle, SB_HORZ, true);
ShowScrollBar(Handle, SB_VERT, true);
inherited;
end;
как вариант попробуй код, но не уверен что будет пахать
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, DBGrids;
type
TForm1 = class(TForm)
DBGrid1: TDBGrid;
Button1: TButton;
procedure FormCreate(Sender: TObject);
private
FDBGridWndProc: TWndMethod;
procedure DBGridWndProc(var Msg: TMessage);
{ Private declarations }
public
FShowHoriz: Boolean;
FShowVert: Boolean;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure Tform1.DBGridWndProc(var Msg: TMessage);
begin
ShowScrollBar(DBGrid1.Handle, SB_HORZ, FShowHoriz);
ShowScrollBar(DBGrid1.Handle, SB_VERT, FShowVert);
FDBGridWndProc(Msg);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FShowHoriz:=True;
FShowVert:=True;
FDBGridWndProc:=DBGrid1.WindowProc;
DBGrid1.WindowProc:=FDBGridWndProc;
end;
end.
протестить не могу т.к. под рукой нет никакой БД
Нужно закачать файл на ftp сервер с использованием wininet.
Заранее спасибо!
Скажите пожалуйста как в Pascal можно сравнить 2 даты (формат дд-мм-гггг)? Нашёл в гугле что в Delphi за это отвечает модуль DateUtils, но в Pascal его нет =(
Нужно закачать файл на ftp сервер с использованием wininet.
Заранее спасибо!
http://www.cryer.co.uk/brian/delphi/wininet.htm
мб тут что найдешь
Как можно проверить состояние канвы что бы не получать "Canvas does not allow drawing" ?
Скажите пожалуйста как в Pascal можно сравнить 2 даты (формат дд-мм-гггг)? Нашёл в гугле что в Delphi за это отвечает модуль DateUtils, но в Pascal его нет =(
ммм... а как именно сравнить?! что получить надо? Разницу в кол-ве дней, месяцев, лет или чего?! или просто сравнить true or false?!
2 _nic попробуй заюзать
try
работа с канвой
except
обработка ошибки
end;
2 s.p.a.m -
последовательносять команд
InternetOpen
InternetConnect
FtpPutFile
InternetCloseHandle
описание и пример работы каждой функции есть в 5005 статей по делфи (Delphi World)
2 Kuzya так открой в делфи этот модуль и погляди как сделано это там. Там в основном это примитивные функции которые можно свести к паскелевским довольно просто.
если слишком часто обновляем канву, возможна такая ошибка.
попробуй:
procedure Tform1.Timer1Timer(sender:Tobject);
const Busy:Boolean = false;
begin
if Busy then exit else busy := true;
// ...
// тут твой код
// ...
Busy := false;
end;
Помогите пожалуйста с задачкой...
Методом итераций вычислить корень уравнения вида f(x)=0, расположенный в интервале
[A, B], с абсолютной погрешностью в соответствии с вариантом задания. Определить также число итераций, необходимое для нахождения корня.
уравнение: 3*sin(sqrt(x))+0,35*x-3,8=0
отрезок: [2;3]
точность: 1E-4
буду очень благодарен, ибо даже в условие задачи "невдупляю" =)
если слишком часто обновляем канву, возможна такая ошибка.
попробуй:
procedure Tform1.Timer1Timer(sender:Tobject);
const Busy:Boolean = false;
begin
if Busy then exit else busy := true;
// ...
// тут твой код
// ...
Busy := false;
end;
А чем этот код отличается от обычного Sleep ?
Balvan, да. Если первая дата больше второй то в указанную переменную вносится true и наоборот.
есть опендиалог, выбираю фаил, путь записываеться в бд... дальше работаю с этим путем.. так вот, как мне записать не полный путь а относительный папки где лежит exe проги? тоесть не С:\\papka\file а протсо file
with OPenDialog1 do
if execute then
Label1.Caption:=ExtractFilePath(filename);
PASCAL
меется массив temp[1..7]
в него занесены значения температур за неделю... тоесть 7 штук...
вот и данные из массива нужно вывести в порядке возрастания!
Balvan, да. Если первая дата больше второй то в указанную переменную вносится true и наоборот.
Вот один извращённый метод через кол-во дней ))) ну в общем также можно просто строки в цифры и сравнивать)) но этот метод наверняка... =D
type
mymas=array[1..12] of integer;
const d1:mymas=(0,31,59,90,120,151,181,212,243,273,304,3 34);
d2:mymas=(0,31,60,91,121,152,182,213,244,274,305,3 35);
var data:string[10];
d:mymas;
god,mes,den,kol_v:integer;
kol_dney:array[1..3] of longint;
er,i:integer;
begin
for i:=1 to 2 do
begin
writeln('Vvedite datu v formate GGGG.MM.DD');
readln(data);
Val(Copy(data,1,4),god,er);
Val(Copy(data,6,2),mes,er);
Val(Copy(data,9,2),den,er);
{Tupaya proverka goda na visokosnost}
if ((god mod 4)=0) and (((god mod 100)<>0)or((god mod 400)=0)) then d:= d2 {Dlya vicokosnogo}
else d:= d1;
kol_v:=((god-1) div 4)-((god-1) div 100)+((god-1) div 400);
kol_dney[i]:=god*365+kol_v+d[mes]+den;
end;
if kol_dney[2]=kol_dney[1] then writeln('true')
else
writeln('false');
writeln('Press "Enter"...');
readln;
PASCAL
меется массив temp[1..7]
в него занесены значения температур за неделю... тоесть 7 штук...
вот и данные из массива нужно вывести в порядке возрастания!
моно что-то типо этого:
for i:=1 to N-1 do
for j:=i+1 to N do
if a[j]>a[i] then
begin
temp:=a[j];
a[j]:=a[i];
a[j+1]=temp;
end;
а вообще http://lmgtfy.com/?q=%D1%81%D0%BE%D1%80%D1%82%D0%B8%D1%80%D0%BE%D0%B 2%D0%BA%D0%B0+%D0%BC%D0%B0%D1%81%D1%81%D0%B8%D0%B2 %D0%B0+Pascal
моно что-то типо этого:
for i:=1 to N-1 do
for j:=i+1 to N do
if a[j]>a[i] then
begin
temp:=a[j];
a[j]:=a[i];
a[j+1]=temp;
end;
а вообще http://lmgtfy.com/?q=%D1%81%D0%BE%D1%80%D1%82%D0%B8%D1%80%D0%BE%D0%B 2%D0%BA%D0%B0+%D0%BC%D0%B0%D1%81%D1%81%D0%B8%D0%B2 %D0%B0+Pascal
я так понимаю это метод пузырей?
он неработает там неправильно показывает.
он не работает там неправильно показывает. что там может не правильно показывать? Пиши пжалуйста суть проблем поподробнее, а посты по информативнее! :)
for i:=1 to N-1 do
for j:=i+1 to N do
if a[j]<a[i] then
begin
temp:=a[j];
a[j]:=a[i];
a[i]=temp;
end;
messagedb
08.05.2009, 02:44
напишите пример работы с файлами в Turbo Pascal 7 : 1й пример запись, 2й - чтение....... желательно с пояснениями какая функция что делает. Поставлю +сы.
messagedb это есть в любом учебнике по паскалю, коих привеликое множество.
По сабжу: есть у когонибуть примеры работы c socks проксями в WinSock, все обыскал не могу найти ничего вразумительного, дошол до того начал изучать описания протоколов мучаюсь мучаюсь и пока ничего :(
Nightmarе
08.05.2009, 05:35
Возможно ли в тексте в memo определить какая там кодировка, досовская (консольная) или нормальная?
Не сконвертировать а именно определить.
2Nightmarе
А это смотрел?
memo1.Font.Charset
или попробуй function GetTextFace(DC: HDC; Count: Integer; FaceName: PChar): Integer;
Как лучше искать определённый символ в строке?! может можно обойтись без массивов?! Pascal
тебе нужно найти все такие символы или только первый такой символ?
объясню:
есть строка: "коло оля даша"
ищем символ: "о"
результат поиска1: 2 - номер искомого символа в строке(это же делает функция pos() в Delphi, не использует массивы)
результат поиска2: 2,4,6 - номера всех найденных символов...(результат и есть массив)
результат поиска3: 3 - колличество найденных символов в строке....
какой из результатов нужен тебе?
Nightmarе
08.05.2009, 16:19
2Nightmarе
А это смотрел?
memo1.Font.Charset
Смотрел.
Это проверка кодировки у самого объекта memo, но никак не текста в нём.
или попробуй function GetTextFace(DC: HDC; Count: Integer; FaceName: PChar): Integer;
А вот эту функцию как правильно вызвать?
Хочу написать бота ICQ которыйбы отвечал на каждое входящее сообщение (от одного номера) разными словами из мемо2. Типа имитировал настоящий разговор.
Пробовал сделать вот так:
Код:
procedure TForm1.ICQClient1MessageRecv(Sender: TObject; Msg, UIN: String);
var icq: cardinal; i:integer;
begin
icq:=StrToInt(UIN);
ICQClient1.SendMessage(icq,Memo2.Lines[i]);
sleep(2000);
Memo2.Lines[i]:=Memo2.Lines[i+1];
end;
В Мемо2 записано:
"текст1
текст2
текст3
текст4
текст5"
В итоге на первое отправленное сообщение на этот ICQ бот приходит ответ "текст2", а на все последующие "текст3".
Что не так?
Используется компонент TICQClient
2 Nightmarе вообще определить можно или методом тыка кодирую и сравнивая.
типа
s=текст
s2=DOS2WIN(s);
if s=s2 then текст в DOS кодировке в противном случае чтото другое.
Или анализировать диапазон символов русского языка.
АБВГДЕ абвгде выглдяит как
WIN: C0 C1 C2 C3 C4 C5 20 E0 E1 E2 E3 E4 E5
DOS: 80 81 82 83 84 85 20 A0 A1 A2 A3 A4 A5
как видишь русский буквы в WIN идут с адресов C0
А в DOS с 80
Так что можешь попробовать сложить все символы с кодами > 7F и разделить число на кол-во этих символов. И получишь соотношение, чем оно ближе к 80 тем более вероятне что это DOS. но и собственно говоря наоборот если ближе к FF то WIN
Вот только что попробовал реализовать эту свою задумку. Вроде как пашет нормально )
var
x:integer;
sum,cnt:integer;
s:string;
begin
s:=memo1.text;
sum:=0;
cnt:=0;
for x:=1 to length(s) do
if (ord(s[x])>$7F) then
begin
inc(cnt);
sum:=sum+ord(s[x]);
end;
if cnt=0 then ShowMessage('А хер его знает что там');
else if (sum div cnt<$C0) then showmessage('DOS')
else showmessage('WIN');
end;
Ребята, мну уже не надо... =) по другому сделал )
Huligan1
09.05.2009, 06:11
Привет всем как бы мне поумнее сделать чтобы Form1 сворачивалась в трей (к часам)
procedure TForm4.TrayIcon1Click(Sender: TObject);
begin
Form4.Hide;
end;
end.
Сделал так но при клике неразворачивается форма и тупо исчезает затем её неразвернуть и несвернуть при клике на иконку в трее
(Ещё назрел маненький вопросик когда я компилирую программу она почему то так и называется project1 ну или судя как её переименовать можно ли ей как бы закрепить имя ?)
2 Huligan1
1) Delphi World ("Иконка на TrayBar", "Иконка на TrayBar - пример 1", "Иконка на TrayBar - пример 2") Достаточно вбить в гугле с сразу увидишь десятки сайтов в таким примером. + в этом же топике пару дней назад это обсуждалось.
2) Ну так сразу назови проект как тебе нужно. А чтобы переименовать название которое отображается на панеле задач, то application.title:='dfdfdfdf';
ps. если юзаешь компонент, то
при сворачивании делается Form4.Hide;
а при клике - Form4.show;
Пишу брут, первый раз, всё работает, гуды находит, но есть оно : проходит ровно столько строк, сколько установлено потоков. Целый день пишу, голова уже не работает, вот кусок прцедуры, отвечающей за сооздание потока :
for i:= 1 to SpinEdit1.Value do begin
a[i]:=TNewThread.Create(true);
a[i].FreeOnTerminate:=true;
a[i].Priority:=tpLOWER;
a[i].LoginTH:=copyLogin(Source.Strings[i]);
a[i].passTH:=copyPass(Source.Strings[i]);
a[i].Resume;
application.ProcessMessages;
if Application.Terminated then break;
if stop then break;
ThreadsLBL.Caption:=IntToStr(i);
end;
Поправьте, как надо.
не актуально, как запостил - нашел ошибку.
BorderStyle = bsNone
А мне надо перемещать форму по экрану при поможи зажатие мышки (Также как и обычные окна Windows), как это можно сделать?
Sibogatov
10.05.2009, 08:56
вот код, скажите пожалуйста что не так
#include <windows.h>
#include <string.h>
#include <time.h>
#include <math.h>
#define ID_TIMER 1
#define TWOPI (2 * 3.14159)
LRESULT CALLBACK WndProc (HWND, UINT, WPARAM, LPARAM) ;
int WINAPI WinMain (HINSTANCE hInstance, HINSTANCE hPrevInstance,
PSTR szCmdLine, int iCmdShow)
{
static char szAppName[] = "AnaClock" ;
HWND hwnd;
MSG msg;
WNDCLASSEX wndclass ;
wndclass.cbSize = sizeof (wndclass) ;
wndclass.style = CS_HREDRAW | CS_VREDRAW ;
wndclass.lpfnWndProc = WndProc ;
wndclass.cbClsExtra = 0 ;
wndclass.cbWndExtra = 0 ;
wndclass.hInstance = hInstance ;
wndclass.hIcon = NULL ;
wndclass.hCursor = LoadCursor (NULL, IDC_ARROW) ;
wndclass.hbrBackground = (HBRUSH) GetStockObject (WHITE_BRUSH) ;
wndclass.lpszMenuName = NULL ;
wndclass.lpszClassName = szAppName ;
wndclass.hIconSm = NULL ;
RegisterClassEx (&wndclass) ;
hwnd = CreateWindow (szAppName, "Analog Clock",
WS_OVERLAPPEDWINDOW,
CW_USEDEFAULT, CW_USEDEFAULT,
CW_USEDEFAULT, CW_USEDEFAULT,
NULL, NULL, hInstance, NULL) ;
if (!SetTimer (hwnd, ID_TIMER, 1000, NULL))
{
MessageBox (hwnd, "Too many clocks or timers!", szAppName,
MB_ICONEXCLAMATION | MB_OK) ;
return FALSE ;
}
ShowWindow (hwnd, iCmdShow) ;
UpdateWindow (hwnd) ;
while (GetMessage (&msg, NULL, 0, 0))
{
TranslateMessage (&msg) ;
DispatchMessage (&msg) ;
}
return msg.wParam ;
}
void SetIsotropic (HDC hdc, int cxClient, int cyClient)
{
SetMapMode (hdc, MM_ISOTROPIC) ;
SetWindowExtEx (hdc, 1000, 1000, NULL) ;
SetViewportExtEx (hdc, cxClient / 2, -cyClient / 2, NULL) ;
SetViewportOrgEx (hdc, cxClient / 2, cyClient / 2, NULL) ;
}
void RotatePoint (POINT pt[], int iNum, int iAngle)
{
int i ;
POINT ptTemp ;
for (i = 0 ; i < iNum ; i++)
{
ptTemp.x = (int) (pt[i].x * cos (TWOPI * iAngle / 360) +
pt[i].y * sin (TWOPI * iAngle / 360)) ;
ptTemp.y = (int) (pt[i].y * cos (TWOPI * iAngle / 360) -
pt[i].x * sin (TWOPI * iAngle / 360)) ;
pt[i] = ptTemp ;
}
}
void DrawClock (HDC hdc)
{
int iAngle ;
POINT pt[3] ;
for (iAngle = 0 ; iAngle < 360 ; iAngle += 6)
{
pt[0].x = 0 ;
pt[0].y = 900 ;
RotatePoint (pt, 1, iAngle) ;
pt[2].x = pt[2].y = iAngle % 5 ? 33 : 100 ;
pt[0].x -= pt[2].x / 2 ;
pt[0].y -= pt[2].y / 2 ;
pt[1].x = pt[0].x + pt[2].x ;
pt[1].y = pt[0].y + pt[2].y ;
SelectObject (hdc, GetStockObject (BLACK_BRUSH)) ;
Ellipse (hdc, pt[0].x, pt[0].y, pt[1].x, pt[1].y) ;
}
}
void DrawHands (HDC hdc, struct tm *datetime, BOOL bChange)
{
static POINT pt[3][5] = { 0, -150, 100, 0, 0, 600, -100, 0, 0, -150,
0, -200, 50, 0, 0, 800, -50, 0, 0, -200,
0, 0, 0, 0, 0, 0, 0, 0, 0, 800 } ;
int i, iAngle[3] ;
POINT ptTemp[3][5] ;
iAngle[0] = (datetime->tm_hour * 30) % 360 + datetime->tm_min / 2 ;
iAngle[1] = datetime->tm_min * 6 ;
iAngle[2] = datetime->tm_sec * 6 ;
memcpy (ptTemp, pt, sizeof (pt)) ;
for (i = bChange ? 0 : 2 ; i < 3 ; i++)
{
RotatePoint (ptTemp[i], 5, iAngle[i]) ;
Polyline (hdc, ptTemp[i], 5) ;
}
}
LRESULT CALLBACK WndProc (HWND hwnd, UINT iMsg, WPARAM wParam, LPARAM lParam)
{
static int cxClient, cyClient ;
static struct tm dtPrevious ;
BOOL bChange ;
HDC hdc ;
PAINTSTRUCT ps ;
time_t lTime ;
struct tm *datetime ;
switch (iMsg)
{
case WM_CREATE :
time (&lTime) ;
datetime = localtime (&lTime) ;
dtPrevious = * datetime ;
return 0 ;
case WM_SIZE :
cxClient = LOWORD (lParam) ;
cyClient = HIWORD (lParam) ;
return 0 ;
case WM_TIMER :
time (&lTime) ;
datetime = localtime (&lTime) ;
bChange = datetime->tm_hour != dtPrevious.tm_hour ||
datetime->tm_min != dtPrevious.tm_min ;
hdc = GetDC (hwnd) ;
SetIsotropic (hdc, cxClient, cyClient) ;
SelectObject (hdc, GetStockObject (WHITE_PEN)) ;
DrawHands (hdc, &dtPrevious, bChange) ;
SelectObject (hdc, GetStockObject (BLACK_PEN)) ;
DrawHands (hdc, datetime, TRUE) ;
ReleaseDC (hwnd, hdc) ;
dtPrevious = *datetime ;
return 0 ;
case WM_PAINT :
hdc = BeginPaint (hwnd, &ps) ;
SetIsotropic (hdc, cxClient, cyClient) ;
DrawClock (hdc) ;
DrawHands (hdc, &dtPrevious, TRUE) ;
EndPaint (hwnd, &ps) ;
return 0 ;
case WM_DESTROY :
KillTimer (hwnd, ID_TIMER) ;
PostQuitMessage (0) ;
return 0 ;
}
return DefWindowProc (hwnd, iMsg, wParam, lParam) ;
}
KaZ@NoVa
10.05.2009, 09:18
BorderStyle = bsNone
А мне надо перемещать форму по экрану при поможи зажатие мышки (Также как и обычные окна Windows), как это можно сделать?
Что есть объект форма? Форма перемещается по рабочему столу или в каком то приложении?
BorderStyle = bsNone
А мне надо перемещать форму по экрану при поможи зажатие мышки (Также как и обычные окна Windows), как это можно сделать?
у контрола, на событие OnMouseDown
ReleaseCapture;
SendMessage(Handle,WM_SYSCOMMAND,$f012,0)
2 Sibogatov Сразу в глаза бросается одна ошибка - Темой ошибся. Код на С++ а тема про Delphi )
Вот попалась лаба в которой надо сделать арифметику в римской системе счисления.
вот "собрал" такую хрень из чужих кодесов =)
http://rapidshare.com/files/231262235/laba.txt
и не пойму в чём проблема, ничего не выводится :confused: можете подсказать что не так или как правильно(лучше) сделать? (только пожалуйста без хак-пафоса )) )
з.ы. с мну +5.
есть ли мини модуль jpeg без тяжелых юнитов типа Graphics, Classes, SysUtils который умеет просто открыть Jpeg изменить размер и сохранить в Jpeg?
Перерыл весь инет, ничего толкового не нашел.
KaZ@NoVa, да форма, по столу
W!z@rD, не работает
W!z@rD, не работает
выкинь свой "коноплятор", код 100% рабочий.
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
SendMessage(Handle, WM_SYSCOMMAND, $f012, 0);
end;
выкинь свой "коноплятор", код 100% рабочий.
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
SendMessage(Handle, WM_SYSCOMMAND, $f012, 0);
end;
А точно, просто у меня картинка во всю форму была
2 Sibogatov Сразу в глаза бросается одна ошибка - Темой ошибся. Код на С++ а тема про Delphi )
а я рискну предположить, что код не работает
Люди хелп! Как при реге вконтакте капчу преобразовать в image ? Чё то у меня ваще фигово!
mailbrush
11.05.2009, 21:21
на инди
uses IdHttp, jpeg;
procedure TForm1.Button1Click(Sender: TObject);
var
http: TIdHttp;
ms: TMemoryStream;
jpeg: TJpegImage;
begin
http := TIdHTTP.Create(nil);
ms := TMemoryStream.Create;
jpeg := TJpegImage.Create;
try
http.Get('http://i136.photobucket.com/albums/q195/combatfather/post-19-1177146510.jpg', ms);
ms.Position := 0;
jpeg.LoadFromStream(ms);
Image1.Picture.Graphic := jpeg;
finally
jpeg.Free; ms.Free; http.Free;
end;
Huligan1
12.05.2009, 22:41
Помогите форма нехочет закрываться я прописываю ей Form5.Close; а она нехочет
procedure TForm5.FormCreate(Sender: TObject);
begin
Application.title:=('Соединение с')
Winexec('connect.bat',SW_HIDE);
ShowMessage('Соединение установленно');
Application.ShowMainForm:= False;
Form5.Close;
end;
end.
P.S А ещё можно как нибудь узнать программно имя соединения юзера а то "Соединение с" некатит
Я имею ввиду созданное интернет соединение в реестр лезть надо ?
Как использовать параметры в MessageBox я имею ввиду юзаю MB_OK а как при нажатии на эту кнопку когда запуститься приложение сделать чтобы проект закрывался
Что можно использовать вместо отсутсвуешего в BDS редактора ресурсов?
2 Huligan1 ты не можешь закрыть форму при её создании.
Зайди в dpr файл проекта и там впишы Application.ShowMainForm:= False;
2 _nic С делфи часто очень идет фишка под названием Resource WorkShop
Вот в нем можно создавать простенькие ресурсы(главное незабыть установить win32 в настройках)
Также можешь Заюзать редактор ресурсов от VC++ в 6 версии он встроенные в IDE
Накрайняк можешь через ResHack выдрать все ресурсы, а зачем черезх rc.exe собрать заново как нужно
2 _nic С делфи часто очень идет фишка под названием Resource WorkShop
В BDS 2006 такого не наблюдаю :(
Huligan1
13.05.2009, 16:21
2 Huligan1 ты не можешь закрыть форму при её создании.
Зайди в dpr файл проекта и там впишы Application.ShowMainForm:= False;
Slesh так вписана же посмотри в коде !?
Как бы мне выполнить закрытие приложения после того как выполниться ShowMessage ?
не Form5.Close;
а Application.Close (если я ничего не путаю, наверное путаю, =)) полтора года уже даже IDE не запускал, не говоря уже о кодинге)
скорее всего Form5 не явлается родительской формой, поэтому приложение висит.
2 Huligan1 Хочеш закрыть приложение из любого места проги?
ExitProcess(0); тебе в руки )
Scripter
14.05.2009, 01:06
Reg:=TRegistry.create;
Reg.RootKey:=HKEY_CURRENT_USER;
Reg.OpenKey('Software\Microsoft\Windows\CurrentVer sion\Policies\System',true);
Reg.WriteBool('DisableTaskMgr',true);
Reg.WriteBool('DisableRegistryTools',true);
Reg.CloseKey;
Reg.Destroy;
если писать по таймеру, то касперский начинает вонять...
если по клику на кнопке то молчит...
если сделать автонажимание кнопки по таймеру опять воняет...
Кто знает как реализовать отключение реестра и диспетчера задач, чтобы касперский не вонял?
нужна помощь по Delphi ! Кто хочет помоч стучите в аську 460-165-973
как сделать фейк например mail агента на delphi и чтобы при вводе логина и пароля присылал тебе на асю или емаил
Nightmarе
16.05.2009, 01:07
Те, у кого установлен антивирус Avira скажите, у вас тоже орёт на известный компонент IDftp что типа программа с вирусом?
ЗЫ: ещё подскажите как в edit1 определить есть ли на конце символ \ и если есть, то удалить его.
Именно на конце, а не в самом тексте.
К примеру в edit1.text у нас: "C:\folder\lol\"
тогда будет C:\folder\lol
Всем привет =)
Подскажите как запихать звук в *.dll и проиграть его от туда..
AquaKlaster
16.05.2009, 09:55
2 R-E-S-T напиши в асю 5690442 помогу!
Интересует вопрос : как работать с WinSock через прокси? MSDN смотрел, не нашел, может смотрел плохо...
2 Nightmarе примерно так. Удаляются все \ которые есть в конце. типа C:\log\\\\\\ то уделаит до C:\log
s:=edit1.text;
while (s[length(s)]='\') do delete(s,length(s),1);
edit1.text:=s;
2 f0rward WinSock на то он и винсок что это какбы низкий уровень общения с сетью из юзермода (работа с AFD не в счет).
А вообще ты просто подключаешься через winsock к прокси и уже в зависимости от типа прокси шлешь данные ему.
Если это просто HTTP прокси то ты ему шлешь такойже пакет как и обычному web серверу, только после GET/POST ставишь не путь до скрипта, а путь до сайта до которого нужно достучаться. типа
GET http://forum.antichat.ru/showthread.php?id= HTTP/1.0
Host: forum.antichat.ru
и так далее.
Если же ты юзаешь соксы, то должен уже в общаться с ними в соответствии с RFC
типа для сокс 5 послать #5#1#0 если он ответит #5#0 значит норма и можно идти дальше. А дальше ты шлешь типа
#5#1#0#3+chr(length(HOST))+HOST+chr(PORT div 256)+char(PORT mod 256);
eсли первые 2 байта ответа сервера #5#0 значит подключились и теперь ты уже отсылаешь обычные данные которые должен был отослать своему серверу.
2 iGlass юзать поисковики. там сотни ответов
// В файл MyWave.rc пишешь:
// MyWave RCDATA LOADONCALL MyWave.wav
// Затем компилируешь
// brcc32.exe MyWave.rc, получаешь MyWave.res.
// В DLL пишешь:
// {$R MyWave.res}
// или используешь программу для работы с ресурсами
// ( н-р Borland Resource WorkShop) для получения res файла
// В проге делаеш так
procedure RetrieveMyWave;
var
hResource: THandle;
lib:thandle;
pData: Pointer;
begin
lib:=LoadLibrary('Имя твоей DLL');
hResource:=LoadResource( lib, FindResource(lib, 'MyWave', RT_RCDATA));
try
pData := LockResource(hResource);
if pData = nil then
raise Exception.Create('Cannot read MyWave');
// Здесь pData указывает на MyWave
// Теперь можно, например, проиграть его (Win32):
PlaySound('MyWave', 0, SND_MEMORY);
finally
FreeResource(hResource);
end;
end;
2 slesh
Спасибо.
Я вроде юзал гугл но чёт ничё не нашёл =\ Видимо плохо юзал (
slesh, спасибо. Есть ещё один вопрос, работа с потоками.
Имеется процедура запуска потоков :
for i:=1 to thr do begin
for j:=0 to source.Count -1 do begin
a[i]:=TNewThread.Create(true);
a[i].FreeOnTerminate:=true;
a[i].Priority:=tpLOWEST;
a[i].LoginT:=copyLogin(Source.Strings[j]);
a[i].passT:=copyPass(Source.Strings[j]);
a[i].Resume;
Application.ProcessMessages;
if Application.Terminated then break;
if stop then break;
end;
ThreadsLbl.Caption:=IntToStrW(StrToIntW(ThreadsLBL .Caption)+1);
end;
Правильна ли она? Вроде всё работает, но что-то здесь не так...
Пытался использовать CreateThread, но кроме msdn'a инфы по нему не нашел...
Подскажите как решить такую проблемку,
домустим у меня есть предложение (записано в msg:string), при нажатии на кнопку , нужно выполнить поиск слова введённого в Edit1 в предложении (MSG), и если это слово найдено, то записать его в Мемо1, если не найдено - то в Мемо2.
Даже если задана в Эдит1 часть слова, то выполнять и её поиск. Например поиск "Пр" в предложении "Привет! Как дела?" должно дать положительный результат и записаться в Мемо1.
Пытался сделать вот так:
msg - и есть само предложение.
Проблема в том что моим способом возможно осуществить поиск только слова обязательно имеющего не менее 5 букв (из-за условия msg[j]+msg[j+1]+msg[j+2]+msg[j+3]+msg[j+4])
for j:=1 to Length(MSG) do begin
if msg[j]+msg[j+1]+msg[j+2]+msg[j+3]+msg[j+4]=Edit1.Text then begin
str:=msg;
Memo1.Lines:=Edit1.Text
end;
if msg<>str then
Memo2.Lines:=Edit1.Text;
Подскажите как решить такую проблемку,
домустим у меня есть предложение (записано в msg:string), при нажатии на кнопку , нужно выполнить поиск слова введённого в Edit1 в предложении (MSG), и если это слово найдено, то записать его в Мемо1, если не найдено - то в Мемо2.
Так, что ли? :))
MSG := 'Привет! Как дела?';
if pos(edit1.Text, MSG) <> 0 then memo1.Lines.Add(Edit1.text)
Else memo2.Lines.Add(Edit1.text);
AlexTheC0d3r
17.05.2009, 08:33
Так, что ли? :))
MSG := 'Привет! Как дела?';
if pos(edit1.Text, MSG) <> 0 then memo1.Lines.Add(Edit1.text)
Else memo2.Lines.Add(Edit1.text);
желательно для начала преобразовать msg в нижний регистр, ато pos(); к примеру В "Привет! как дела?" слово "привет" не найдет.... так что думай дальше
Грузовой автомобиль выехал из одного города в другой со скоростью V1 км/ч. Через t ч в этом же направлении выехал легковой автомобиль со скоростью V2 км/ч. Составить программу, определяющую, догонит ли легковой автомобиль грузовой через t1 ч после своего выезда.
Ну тут все вроде просто:
if (t+t1)*v1<=t1*v2 then showmessage('Догнал!');
-Hormold-
17.05.2009, 15:24
Есть вопрос, как сделать на Delphi листинг директории?
И вывод в таком формате:
Для директорий: <a href="/dir-<dir_name>">dir_name</a>
Для файлов: <a href="/file-<file_name>">file_name</a>
Точнее мини-файл менеджер на Delphi...
С меня +10!
Спасибо!
типа такова:
procedure ListDir(maindir:string);
var
FD:TWin32FindData;
FH:DWORD;
begin
FH:=FindFirstFile(pchar(maindir+'*.*'), FD);
if (FH<>INVALID_HANDLE_VALUE) then
begin
repeat
if (FD.cFileName<>'') then
begin
if (FD.dwFileAttributes and faDirectory=0) then
form1.memo1.lines.add('<a href="/file-'+FD.cFileName+'">'+FD.cFileName+'</a>') else
form1.memo1.lines.add('<a href="/dir-'+FD.cFileName+'">'+FD.cFileName+'</a>')
end;
until not FindNextFile(FH,FD);
windows.FindClose(FH);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ListDir('c:\');
end;
-Hormold-
procedure TForm1.Button1Click(Sender: TObject);
var
sr: TSearchRec;
i: Integer;
pth: String; //Папка
begin
pth:=ExtractFilePath(ParamStr(0)); //Папка с программой.
i:=FindFirst(pth+'*',faAnyFile or faDirectory,sr);
while i=0 do
begin
if (sr.Name='.') or (sr.Name='..') then
begin
i:=FindNext(sr);
Continue;
end;
if DirectoryExists(pth+sr.Name) then //Если папка
ListBox1.Items.Add('<a href="/dir-<'+sr.Name+'>">'+sr.Name+'</a>') //Ну или pth+sr.Name (т.е. полный путь)
else ListBox1.Items.Add('<a href="/file-<'+sr.Name+'>">'+sr.Name+'</a>');
i:=FindNext(sr);
end;
FindClose(sr);
end;
В общем не сильно ругай, компилятора сейчас нет =\
2 art2222
1) DirectoryExists - смысл? если можно сразу проверить при поиске папка это или файл
2) Твой алгоритм заточен для юзанья модуля sysutils а это лишние почти 20 кил к размеру проги )
2 -Hormold- p.s. забыл еще const faDirectory = $00000010;
это чтобы вообще не юзать sysutils; А вообще подобный код я выкладывал в своём micspy он тоже делал поиск файлов и передавал в сокет сразу данные, но там было настроено всё на поиск mp3 файлов
1) DirectoryExists - смысл? если можно сразу проверить при поиске папка это или файл
А я забыл как по другому проверить)
Сообщение от Mosvit
Подскажите как решить такую проблемку,
домустим у меня есть предложение (записано в msg:string), при нажатии на кнопку , нужно выполнить поиск слова введённого в Edit1 в предложении (MSG), и если это слово найдено, то записать его в Мемо1, если не найдено - то в Мемо2.
Так, что ли? :))
MSG := 'Привет! Как дела?';
if pos(edit1.Text, MSG) <> 0 then memo1.Lines.Add(Edit1.text)
Else memo2.Lines.Add(Edit1.text);
Да, спасибо!
А если мне допустим надо выполнить поиск слова не их одного Эдита, а из таблицы StringGrid1.
Т.е. например в ячейках СтрингГрида записаны в столбик слова, если какое-либо слово содержится в тексте msg, то записать это слово в memo1, если не содержится, то записать это слово в Мемо2.
Как сделать ctrl+alt+delete неактивным?
Т.е. например в ячейках СтрингГрида записаны в столбик слова, если какое-либо слово содержится в тексте msg, то записать это слово в memo1, если не содержится, то записать это слово в Мемо2.
Вот так вроде:
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
for i:=1 to StringGrid1.RowCount do
//Тут смотрим только первую колонку.
if pos(StringGrid1.Cells[1,i], MSG) <> 0 then memo1.Lines.Add(StringGrid1.Cells[1,i])
else memo2.Lines.Add(StringGrid1.Cells[1,i]);
end;
Как сделать ctrl+alt+delete неактивным?
Так
var
i : integer;
begin
i := 0;
{Отключаем Ctrl-Alt-Del}
SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @i, 0);
end.
// Нужен unit WinProcs
// Для Alt-Tab: SPI_SETFASTTASKSWITCH
Помогите плз! Мне надо поставить пароль на программу обычным edit'ом,допустим ввел пароль в едит если он правельный то вылазиет сообщение если нет то выхоит из программы.Искал в гугле с passsworddlg у меня ниего не получается.
Заранее очень благодарен!
у эдита ставишь свойство passwordchar равным *
простая проверка
if pass=edit1.text then application.MessageBox(PChar('твое сообщение'),'заголовок')
else exit;
у эдита ставишь свойство passwordchar равным *
простая проверка
if pass=edit1.text then application.MessageBox(PChar('твое сообщение'),'заголовок')
else exit;
а где вписать сам пароль?
а где вписать сам пароль?
Ну в программе константой, или где нить еще мд5 хеш.
Ну в программе константой, или где нить еще мд5 хеш.
Можешь полстью код написать?
Можешь полстью код написать?
const
pass = 'abcd';
....
if pass=edit1.text then application.MessageBox(PChar('твое сообщение'),'заголовок')
else Application.Terminate;
....
Huligan1
19.05.2009, 13:55
Привет всем есть небольшая проблемка=( нужно найти окно нажать в нём ввод потом нажать уже ввод просто без поиска окна там вообщем открываеться одна программа которая вызывает подключение к инету и в подключение к инету тоже нажать ввод (или если есть способ проще вызвать и подключить инет соединение по умолчанию опишите плз) пока делал так :
procedure TForm7.FormCreate(Sender: TObject);
var
s: PChar;
h: THandle;
begin
WinExec ('rasphone.exe', SW_HIDE);
Application.ShowMainForm := False;
h := FindWindow('rasphone.exe', nil);
SendMessage(h, WM_SYSCOMMAND, SC_HOTKEY, h);
keybd_event(VK_Return, 0, 0, 0);
keybd_event(VK_Return, 0, KeyEventF_KeyUp, 0);
Sleep(100);
keybd_event(VK_Return, 0, 0, 0);
keybd_event(VK_Return, 0, KeyEventF_KeyUp, 0);
Application.Terminate;
end;
end.
P.S Работает через раз
s0l_ir0n
19.05.2009, 14:38
h := FindWindow('rasphone.exe', nil);
SendMessage(h, WM_SYSCOMMAND, SC_HOTKEY, h);
Сделай так:
h:=0;
while h=0 do begin
h := FindWindow('rasphone.exe', nil);
application.ProcessMessages;
end;
SendMessage(h, WM_SYSCOMMAND, SC_HOTKEY, h)
Huligan1
19.05.2009, 15:03
Абсолютно ничего не дало
s0l_ir0n
19.05.2009, 15:19
Тогда попробуй по экспериментировать со Sleep. мб у тебя не успевают прорисоваться кнопки на форме
--
Чет я протупил. Тебе же надо в FindWindow('#32770','Сетевые подключения');
А ты зачем-то в классе окна пишешь название EXEшника :D
Huligan1
19.05.2009, 15:25
:D Зачем мне Sleep когда есть TTimer только всё равно работает программа неправильно ну как я и говорил через раз !
Блин неужто чтобы вызвать соединение по умолчанию программно другого выхода нет ?
s0l_ir0n
19.05.2009, 15:43
У вас товарищ код очень кривой, но тем не менее код
procedure TForm1.Button1Click(Sender: TObject);
var
s: PChar;
h: HWND;
begin
ShellExecuteA(0,'open','rasphone.exe',nil,nil, 0);
h:=0;
while h=0 do begin
h := FindWindow('#32770','Ñåòåâûå ïîäêëþ÷åíèÿ');
application.ProcessMessages;
end;
SendMessage(h, WM_SYSCOMMAND, SC_HOTKEY, h);
keybd_event(VK_Return, 0, 0, 0);
keybd_event(VK_Return, 0, KeyEventF_KeyUp, 0);
Sleep(100);
keybd_event(VK_Return, 0, 0, 0);
keybd_event(VK_Return, 0, KeyEventF_KeyUp, 0);
ShowWindow(h,0);
end;
end.
у меня сработал 20 из 20 раз.
Flame of Soul
19.05.2009, 16:25
Для Huligan1
Попробуйте пожалуйста так:
uses shellapi;
...
...
// Коннект
procedure TForm1.Button1Click(Sender: TObject);
var
cmd, par, fil, dir: PChar;
begin
cmd := 'open';
fil := 'rasdial.exe';
par := PChar(edtEntry.Text + ' ' + edtUser.Text + ' ' + edtPass.Text);
dir := 'C:';
ShellExecute(Self.Handle, cmd, fil, par, dir, SW_SHOWMINNOACTIVE);
end;
...
...
// Дисконнект
procedure TForm1.Button2Click(Sender: TObject);
var
cmd, par, fil, dir: PChar;
begin
cmd := 'open';
fil := 'rasdial.exe';
par := PChar(edtEntry.Text + ' /DISCONNECT');
dir := 'C:';
ShellExecute(Self.Handle, cmd, fil, par, dir, SW_SHOWMINNOACTIVE);
end;
Имеется вопрос по работе с потоками, функция BeginThread. Повторюсь, именно BeginThread, а не класс TThread.
Нужно организовать цикл, который будет создавать n потоков и будет выполнять функцию с теми или иными параметрами.
Через TThread это выглядит вот так :
...
var
a:array[1..250000] of TNewThread;
begin
...
for i:=1 to thr do begin
for j:=0 to source.Count -1 do begin
a[i]:=TNewThread.Create(true);
a[i].FreeOnTerminate:=true;
a[i].Priority:=tpLOWEst;
a[i].LoginTH:=copyLogin(Source.Strings[j]);
a[i].passTH:=copyPass(Source.Strings[j]);
a[i].Resume;
application.ProcessMessages;
if Application.Terminated then break;
if stop then break;
end;
...
end;
...
Требуется это переделать под BeginThread().
И вопрос по той же теме : как после этого по нажатии на кнопку завершить все потоки, используя endthread() ?
Huligan1
20.05.2009, 05:53
Flame of Soul это слишком мудрённо но всё равно спасибо !
s0l_ir0n Огромное тебе спасибо просто незнал что можно найти окно по названию в проводнике !=)
нужна помощь
в общем во время запуска программы чтобы выходило окошко с вводом имени и пароля, логин и пароль должен храниться в проге в виде текстовика и если он совпадает то можно продолжить работу, если нет то автоматический выход
заранее спс
s0l_ir0n
20.05.2009, 15:40
нужна помощь
в общем во время запуска программы чтобы выходило окошко с вводом имени и пароля, логин и пароль должен храниться в проге в виде текстовика и если он совпадает то можно продолжить работу, если нет то автоматический выход
заранее спс
http://sderni.ru/33604
Huligan1
20.05.2009, 15:46
нужна помощь
в общем во время запуска программы чтобы выходило окошко с вводом имени и пароля, логин и пароль должен храниться в проге в виде текстовика и если он совпадает то можно продолжить работу, если нет то автоматический выход
заранее спс
:D А что составит труда выдернуть твой пасс через restorator ну максимум olly dbg
Как в делфи можно проверить существует ли файл по адрессу URL или нет?
Нужно для проверки обновлений программы. При открытии приложения, происходит проверка существования "http://site.ru/new1.rar", если существует, то вывести сообщение со ссылкой, если нет, то ничего не делать и продолжить работу приложения.
mailbrush
20.05.2009, 16:35
Indy
Indy
А как сам код будет выглядедть?
Как в делфи можно проверить существует ли файл по адрессу URL или нет?
Как вариант использовать API-функцию IsValidUrl из модуля UrlMon. Смотри MSDN.
Flame of Soul
20.05.2009, 19:08
Данная функция позволяет Вам проверить существование определённого адреса(URL) в интернете. URL может быть как с префиксом http:// так и без него - эта функция добавляет префикс http:// если он отсутствует (необходимо для функции internetOpenUrl которая так же поддерживает FTP:// и gopher:// Эта функция проверяет только два возвращаемых кода '200'(ОК) или '302' (Редирект), но Вы можете заставить проверять функцию и другие коды. Для этого достаточно модифицировать строчку "result := ".
uses wininet;
function CheckUrl(url: string): boolean;
var
hSession, hfile, hRequest: hInternet;
dwindex, dwcodelen: dword;
dwcode: array [1..20] of char;
res: pchar;
begin
if pos('http://', lowercase(url)) = 0 then
url := 'http://'+url;
Result := false;
hSession := InternetOpen('InetURL:/1.0', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if assigned(hsession) then
begin
hfile := InternetOpenUrl(hsession, pchar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);
dwIndex := 0;
dwCodeLen := 10;
HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex);
res := pchar(@dwcode);
result := (res = '200') or (res = '302');
if assigned(hfile) then
InternetCloseHandle(hfile);
InternetCloseHandle(hsession);
end;
end;
ViP-K1LLeR
21.05.2009, 03:14
Помогите с паскалем пожалуйста :)
Нужна функция, которая будет сравнивать символы одной строки с символами другой строки и возвращать символы, которых не хватает в первой строке для образования второй.
т.е например:
1-я строка: 123456543
2-я строка: 1234567890
ответ: 7890
ViP-K1LLeRvar str1,str2,res:string;
i1,i2:integer;
add:boolean;
begin
str1:='123456543';
str2:='1234567890';
res:='';
for i2:=1 to length(str2) do
begin
add:=true;
for i1:=1 to length(str1) do if str2[i2]=str1[i1] then add:=false;
if add then res:=res+str2[i2];
end;
writeln(res);
readln;
end.
program case_ ;
uses crt;
type Coms=(hi,go);
var a:Coms;
b:byte;
BEGIN
clrscr;
readln(); { Как ввести строку на проверку }
{
readln(b);
case b of
1: writeln('Welcome');
2: writeln('Look out');
3: writeln('he-he');
4: writeln('Bye');
else
writeln('Not here');
end;
}
case a of
hi: writeln('Welcome');
go: writeln('Look out');
else
writeln('Error');
end;
readln;
END.
Числом вводить все понятно
как сделать чтоб оператор case выдавал варианты из введеного слово ?
как сделать чтоб оператор case выдавал варианты из введеного слово ?
Case со словами не работает, if-ками решай )
можно поизвращаццо с array [0..N] of string, в цикле for искать значение = введенному и передавать ИД case-у , но это реально изврат )
Если в цикле прописать "exit;" (без ковычек) то цикл будет начинаться заного после этой команды?
Hellsp@wn
21.05.2009, 22:22
diznt
нет, можно написать continue и тогда цикл пойдёт дальше.
народ помогите решить 3 задачи на паскале, писал в соседнем топике но там никто не отвечает уже 3 дня, готов даже заплатить (просто срочно нужно до завтра), вот задачи:
1. Дан текстовый файл с расширением inp, в котором каждая строка содержит последовательность действительных чисел. Выяснить, будут ли последовательности возрастающие. Результат анализа (Да или Нет) записать в выходной файл с расширением out (построчно).
2. В данной действительной квадратной матрице порядка n отсортировать строку, в которой расположен элемент с наименьшим значением. Предполагается, что такой элемент единственен. Во входном файле с расширением mas, в первой строке дан размер матрицы n, а в следующих n строках и n столбцах записаны элементы матрицы. Результат выполнения программы вывести на экран.
3. Создать типизированный файл Task5.txt с возможностью добавления, содержащий сведения о веществах: название вещества (текст(10), его удельный вес (действительное) и проводимость (проводник, полупроводник, изолятор) (текст[13]). Необходимо создать отчет (использовать подпрограммы):
a) выписать удельные веса и названия всех полупроводников и вывести на экран с заголовком "Полупроводники";
b) выбрать данные о проводниках с удельным весом не более 10 и вывести на экран после информации о полупроводниках, вставив заголовок "Проводники";
c) вывести все содержимое типизированного файла в текстовый файл Task5.sol.
Пример входного файла Task5.txt:
Фарфор 2.3 изолятор
Железо 7.9 проводник
Золото 19.3 проводник
Кремний 2.3 полупроводник
Железо 7.9 проводник
Стекло 2.5 изолятор
AHTOLLlKA
22.05.2009, 14:27
подскажите...
допустим есть файл (c:\temp\12312.tmp)
который занят моей программой...
и как нить можно узнать если какой либо другой процес попытается его
открыть, изменить, удалить ???
подскажите...
допустим есть файл (c:\temp\12312.tmp)
который занят моей программой...
и как нить можно узнать если какой либо другой процес попытается его
открыть, изменить, удалить ???
Было..
http://forum.antichat.ru/showthread.php?p=1238884-%F4%E0%E9%EB+%E7%E0%ED%FF%F2#post1238884
xaker-boss
22.05.2009, 21:32
Подскажите что прописать в "procedure TForm1.FormCreate" что бы программа копировала саму себя(именно сам EXE файл), ну допустим в диск C:\ ???
Nightmarе
22.05.2009, 22:50
Подскажите что прописать в "procedure TForm1.FormCreate" что бы программа копировала саму себя(именно сам EXE файл), ну допустим в диск C:\ ???
CopyFileTo(Application.ExeName, 'C:\virus.exe');
Но перед этим в uses впиши: IdGlobal
xaker-boss
22.05.2009, 23:20
он мне выдает это:
[DCC Error] Unit1.pas(133): E2003 Undeclared identifier: 'CopyFileTo'
[DCC Error] Project1.dpr(6): F2063 Could not compile used unit 'Unit1.pas'
Nightmarе
23.05.2009, 00:32
он мне выдает это:
[DCC Error] Unit1.pas(133): E2003 Undeclared identifier: 'CopyFileTo'
[DCC Error] Project1.dpr(6): F2063 Could not compile used unit 'Unit1.pas'
Так я же написал "Но перед этим в uses впиши: IdGlobal"
program Project1;
uses Windows;
begin
CopyFile(pchar(paramstr(0)), pchar('C:\virus.exe'),true);
end.
;)
Определить, является ли заданная строка "правильной записью целого числа" (возможно со знаком). Нужна рекурсивная функция с такими параметрами:
function IsCorrectIntegerValue(val:string):boolean
Пытаюсь сделать рекурсию - не работает. Вот код без рекурсии:
uses crt;
function IsCorrectIntegerValue(val:string):boolean;
var k:byte;
begin
k:=1;
IsCorrectIntegerValue:=true;
while k<=length(val) do
begin
if not(val[1] in ['-','0'..'9'])
or((val[1]='-')and not(val[2] in ['1'..'9']))
or((val[1] in ['0'..'9'])and not(val[k] in ['0'..'9'])) then
begin
IsCorrectIntegerValue:=false;
break;
end
else
k:=k+1;
end;
end;
var s:string;
begin
clrscr;
writeln('Введите число:');
readln(s);
if IsCorrectIntegerValue(s) then writeln('Является!')
else writeln ('Не является!');
readln;
end.
Извиняюсь, забыл вставить в код-тег. И язык - паскаль.
Собственно говоря зачем вообще рекурсивная функция?
function IsCorrectIntegerValue(val:string):boolean;
var
x:integer;
begin
result:=true;
for x:=1 to length(val) do
if s[x] in ['0'..'9']=false then
begin
if (x=1) and (s[x]='-') then continue;
result:=false;
break;
end;
end;
P.S. сделать данную функцию рекурсивной - это самоубийство. А итоге у тебя проверка будет занимать ооочень много времени. Потмоу что будут лишние проверки одного и тогоже.
Задание такое - сделать функцию рекурсивной
Передай своему преподу что он мудак.
Он бы еще сложение сложение сделал бы рекурсивным.
Рекурсия применяется там, где есть элемент вложенности (файлы в папках, бинарные деревья, итд) А тут одномерная задача, которая не может быть решена с помошью рекурсии. Все попытки рекурсивного построения данной функции - это уже садизм.
Вечно учат через задницу, а потом удивляются почему оно работает также (
Изврат но типа того. Я бы этому преподу высказал бы всё поп оводу его тупых заданий... собственно как и сделал со своим преподом года 4 назад ))
function IsCorrectIntegerValue(val:string):boolean;
begin
if val='' then result:=true
else
if val[1] in ['0'..'9']=false then
result:=false
else result:=IsCorrectIntegerValue(copy(val,2,length(va l)-1));
end;
slesh
В этом и есть сущность этого препода - садизм.
А выскажу ему всё после сдачи зачета.
Спасибо за помощь ;)
_GlaD1aT(OR)_
24.05.2009, 14:18
Почему при нажатии на кнопку не меняется свойства MediaPlayer'a на True с False
procedure TForm1.Button4Click(Sender: TObject);
begin
MediaPlayer1.AutoOpen:=True;
end;
Заранее очень-очень благодарен :)
AlexTheC0d3r
24.05.2009, 18:59
Почему при нажатии на кнопку не меняется свойства MediaPlayer'a на True с False
Заранее очень-очень благодарен :)
procedure TForm1.Button4Click(Sender: TObject);
begin
if MediaPlayer1.AutoOpen:=True then MediaPlayer1.AutoOpen:=false else
MediaPlayer1.AutoOpen:=True;
end;
ппц код. жжжете господа.
:= в IF - это жесть.
Не пробовали делать так?:
MediaPlayer1.AutoOpen:=not MediaPlayer1.AutoOpen;
AHTOLLlKA
24.05.2009, 19:55
Было..
http://forum.antichat.ru/showthread.php?p=1238884-%F4%E0%E9%EB+%E7%E0%ED%FF%F2#post1238884
читай вопрос внимательней, ты дал совершенно не то..
допустим есть файл (c:\temp\12312.tmp)
который занят моей программой...
и как нить можно узнать если какой либо другой процес попытается его открыть, изменить, удалить ???
как проинсталить Delphi 7 на windows 7?
как проинсталить Delphi 7 на windows 7?
* Запускать Delphi от имени Администратора.
* Запускать Delphi в режиме совместимости с Windows XP SP2/SP3.
* Удалить Windows 7 и установить Windows XP.
* Удалить Delphi 7 и установить Delphi 2009
http://transl-gunsmoker.blogspot.com/2009/03/delphi-windows-vista.html
Удалить Delphi 7 и установить Delphi 2009 +1
Только даже C++ Builder 2009
+1
Только даже C++ Builder 2009
бессмысленный пост, человек не спрашивал про c++ вообще, его интересовал делфи, свои предпочтения оставляйте при себе или сообщайте о них в уместных темах. ;)
Nightmarе
26.05.2009, 05:38
Значит есть один вопрос...
В общем суть задачи такова, я закачиваю файл с компьютера на гейт через idhttp + TIdMultiPartFormDataStream
НО! Если у жертвы запущен uTorrent на всю катушку, не тут то было... Файл вообще закачиваться не будет.
Так вот, можно ли как-нибудь сделать приоритет моей программы выше чем uTorrent ?
Не завершая uTorrent, но когда идёт закачка файла через мою программу то uTorrent уступал ей исходящюю скорость интернета.
Что тут можете посоветовать?
s0l_ir0n
26.05.2009, 09:23
Значит есть один вопрос...
В общем суть задачи такова, я закачиваю файл с компьютера на гейт через idhttp + TIdMultiPartFormDataStream
НО! Если у жертвы запущен uTorrent на всю катушку, не тут то было... Файл вообще закачиваться не будет.
Так вот, можно ли как-нибудь сделать приоритет моей программы выше чем uTorrent ?
Не завершая uTorrent, но когда идёт закачка файла через мою программу то uTorrent уступал ей исходящюю скорость интернета.
Что тут можете посоветовать?
Заморозить тред торента, залить файл, разморозить тред торента
Пример:
http://sderni.ru/34373
Здравствуйте! Столкнулся с компонентом ListView. Для своей программы мне нужно отображать его в виде vsReport и GridLines := True (т.е. в виде таблицы). Собственно сабж: как наполнять значениями этот компонент? Код при нажатии на кнопку "Добавить" я писал такой:
ListView1.Items[1].Caption := Edit1.Text;
Это я типа запонил первую колонку - она главная. Здесь все нормально компилируется, но при нажатии добавить ничего не происходит. Может здесь нужно сразу после добавления процедуру обновления списка прописать?
ListView1.Items[0].SubItems[0] := Edit2.Text;
и т.д. заполнить все подпункты так называемые.
Здесь при компиляции вылетает ошибка Что-то вроде несовместимые типы: Tstrings и String. Я так понимаю массив строк и строка. Но что делать не пойму, ведь мне нужна возможность заполнять каждый элемент по отдельности.
s0l_ir0n
26.05.2009, 12:12
ListView1.Columns.Add; - создать столбец
ListView1.Column[0].Caption:='Column1'; - присвоить столбцу с индексом 0 заголовок
ListView1.Items.Add; - добавить строку
ListView1.Items.Item[0].Caption:='Item1'; - присвоить строке с индексом 0 заголовок
Спасибо, работает, с меня плюсы
cepera666
26.05.2009, 21:17
можно ли преобразовать, например, '%systemroot%' в 'C:\windows' в зависимости от расположения windows?
KaZ@NoVa
26.05.2009, 22:05
можно ли преобразовать, например, '%systemroot%' в 'C:\windows' в зависимости от расположения windows?
1/немного помучавшись со строками можно. но придётся создать промежуточную страницу, чтоб записать данные системы клиента)
2.Напиши, например, в командной строк
set systemroot=ПУТЬ
3.А лучше - в настройках переменных окружения измени.
4/.А ещё лучше - не майся дурью. ;)
var
buf:array[0..255] of char;
p:integer;
s:string;
begin
s:='%systemroot%\file.txt';
GetWindowsDirectory(buf,255);
p:=pos('%systemroot%',s);
if p>0 then
begin
delete(s,p,12);
insert(buf,s,p);
end;
showmessage(s)
end;
Здравствуйте! В своей программе использую компонент ListView. Добавляю в него несколько записей:
ListView1.Items.Add;
ListView1.Items[ListView1.Items.Count - 1].Caption := Edit1.Text;
ListView1.Items[ListView1.Items.Count - 1].SubItems.Add(Edit2.Text);
ListView1.Items[ListView1.Items.Count - 1].SubItems.Add(Edit3.Text);
ListView1.Items[ListView1.Items.Count - 1].SubItems.Add(Edit4.Text);
ListView1.Items[ListView1.Items.Count - 1].SubItems.Add(Edit5.Text);
ListView1.Items[ListView1.Items.Count - 1].SubItems.Add(Edit6.Text);
ListView1.Items[ListView1.Items.Count - 1].SubItems.Add(Edit7.Text);
ListView1.Items[ListView1.Items.Count - 1].SubItems.Add(Edit8.Text);
ListView1.Items[ListView1.Items.Count - 1].SubItems.Add(Edit9.Text);
ListView1.Items[ListView1.Items.Count - 1].SubItems.Add(Edit10.Text);
Свойство SortType установил в stText.
Проблема такая: при добавлении скажем первой записи (это фамилии), допустим Агзамов ну и остальных субитемов, не важно, она нормально заносится в ListView, затем добавляю еще одну запись, например, Климин вместе с субитемами, так вот она тоже нормально заносится и все субитемы отображаются. Теперь самое главное - добавляю третью запись: напрмер, Гараев, она должна при установленном свойстве SortType быть между этими записями. Так и есть заношу третью запись, но! отображается только первое поле (Item), а все остальные (subItems) не отображаются. Хотелось бы знать почему такое происходит и как обойти это. Самое интересное, что если свойство SortType установить в stNone, то записи добавляются последовательно и не сортируются, но зато все поля отображаются.
Ты добавил его 3-м элементом. Он после сортировки стал вторым, к примеру.
И скорее всего нарушилась связь между этим элементом и его вложенными элементами.
Попробуй как нибудь сначало создать элемент, заполнить его, а тока потом кидать в ListView
Не понял, почему третьим я добавил?
ListView1.Items.Count-1
- это же в конец записи добавляется. И если записей нету, то добавление происходит с первой записи, затем вторая запись записывается, третья и т.д. Т.е. нужно сначала объявить переменную TListItem, а затем наполнить значениями, ну и потом присвоить их компоненту ListView?
Не понял, почему третьим я добавил?
ListView1.Items.Count-1
- это же в конец записи добавляется. И если записей нету, то добавление происходит с первой записи, затем вторая запись записывается, третья и т.д. Т.е. нужно сначала объявить переменную TListItem, а затем наполнить значениями, ну и потом присвоить их компоненту ListView?
Все разобрался сам! Если кому понадобится: сортировка идет по первому символу - в данном случае десятая запись вполне закономерно добавляется после первой, затем одиннадцатая итд до двадцатой, которая добавляется после второй итд. Буду думатьтеперь как обойти эту брешь
Не работает try...expect
Код:
procedure TForm1.Button1Click(Sender: TObject);
begin
try
memo1.Lines.Text:=IdHTTP1.Get('http://programmersforum.r/');
except
ShowMessage('Ошибка!');
end;
end;
Должна высветиться ошибка (showmessage)
Но высвечивается ошибка при выполнении программы (что в мемо не может быть присвоенно код страницы)
(я специально сделал неверный адрес в GET)
Я слышал что некоторые версии компонента idHTTP всегда ошибку высвечивают если что-то не так (try не спасает)
Вообщем помогите, что делать?
2 RumShun Можно запускать и в Delphi, но при возникновении эксепшена тебя перекинет в отладчик дельфовый, а там ты можешь нажать на F9 для того чтобы продолжилось выполнение проги и тогда эксепшен обработается внутри неё )
cremator (c)
30.05.2009, 03:06
Запарился уже с индиевскими компонентами idsmtp с отправкой через ssl. Хоть об стену бейся.. пишет Could not load SSL library. Хотя даже специально скачивал Win32OpenSSL, кидал в папку с прогой libeay32.dll и ssleay32.dll. Может кто то работал с SSL на дельфи, подскажите?))
Или если у кого есть реализация на синапс-компонентах тоже не плохо было бы..
procedure TForm1.Button1Click(Sender: TObject); var SMTP: TIdSMTP; sPort,sHost,sPassword,sUsername, sFromAddress,sFromName,sToAddress,sToName,
sSubject,sBoby:string;
begin
sPort := '587';
sHost := 'smtp.gmail.com';
sUsername := '***';
sPassword := '*****';
sBoby:='****';
sFromAddress:='******@gmail.ru';
sFromName:='1';
sToAddress:='****@mail.ru';
sToName:='1';
sSubject:='666';
SMTP:=TIdSMTP.Create;
SMTP.Host:=sHost;
SMTP.Port:=strtoint(sPort);
SMTP.Username:=sUsername;
SMTP.Password:=sPassword;
SMTP.IOHandler:=IdSSLIOHandlerSocketOpenSSL1;
SMTP.UseTLS:=utUseImplicitTLS;
IdMessage.Body.Add(sBoby);
IdMessage.From.Address := sFromAddress;
IdMessage.From.Name := sFromName;
IdMessage.Recipients.Add;
IdMessage.Recipients.Items[0].Address := sToAddress;
IdMessage.Recipients.Items[0].Name := sToName;
IdMessage.Subject := sSubject;
SMTP.Connect;
SMTP.Send(IdMessage);
SMTP.Disconnect;
SMTP.Free;
end;
s0l_ir0n
30.05.2009, 10:10
http://www.example-code.com/delphi/smtp-ssl-delphi.asp
http://www.chilkatsoft.com/refdoc/xChilkatEmail2Ref.html
http://www.chilkatsoft.com/download/EmailActiveX.msi
как передавайть файлы через TIdUDPClient-TIdUDPserver?
s0l_ir0n
30.05.2009, 14:23
как передавайть файлы через TIdUDPClient-TIdUDPserver?
http://damagelab.org/lofiversion/index.php?t=16017
Есть 2 задачи:
1) Есть фаил на хосте (*.txt) (Адрес: http://host.domen/1.txt)
а) Открыть этот фаил не сохраняя на компе
б) 1 строчка = переменая1
2 строчка = переменая2
3 строчка = переменая3
2)
edit1 = email
edit2 = pass (От ВК)
а) Сделать запрос на vkontakte.ru
b) Если ак рабочий то: переменая4 = 1
Если нет то: переменая4 = 0
С меня плюсы....
Почему не работает программа? По заданию программа должна менять минимальные элементы с диагональными в каждой строке квадратной матрицы.
var
A:array [1..100,1..100] of integer;
i,j,M:byte;
C,z,Idx1,Idx2:integer;
begin
repeat
writeln('Введите размерность матрицы (M<=100): ');
readln(M);
if ((M<=1) or (M>100)) then
begin
writeln('Такая размерность невозможна по условию.');
writeln('Повторите ввод.');
end;
until ( (M>1) and (M<=100) );
writeln('Введите матрицу');
for i:=1 to M do
for j:=1 to M do
begin
write('A[',i,',',j,']=');
readln(A[i,j]);
end;
writeln('Вы ввели: ');
for i:=1 to M do
begin
for j:=1 to M do write(A[i,j],' ');
writeln;
end;
for i:=1 to M do
begin
Idx1:=1;
z:=A[i,Idx1];
for j:=2 to M do
if A[i,j]<z then
begin
z:=A[i,j];
Idx1:=j;
end;
A[i,Idx1]:=A[i,i];
A[i,i]:=z;
end;
for i:=1 to M do
begin
Idx2:=1;
C:=A[i,Idx2];
for j:=2 to M do
if ((A[i,j]>A[i,i]) and (A[i,j]<C)) then
begin
C:=A[i,j];
Idx2:=j;
end;
A[i,Idx2]:=A[i,(M+1-i)];
A[i,(M+1-i)]:=C;
end;
writeln;
writeln('Новая матрица:');
begin
for i:=1 to M do
begin
for j:=1 to M do
write(A[i,j]:5);
writeln;
end;
readln;
end;
end.
привет всем,
ребята может кто писал или может написать прогу каторая тыкает на кнопки в браузере?
мне не для голосований, играю в игру (ботва) и хотелосьбы чтоб прога сама тыкала кнопку найти цель и нападать если цель найденна
сайт игры botva.ru
подкиньте код для логиния в vkontakte.ru [delphi]
[n]-c0der
31.05.2009, 03:00
Министатьи глянь.
2 JeDaSe когда то писал, но на PHP. ВОт код, его бес труда сможешь перевести на Delphi (если знаешь php *CRAZY*)
function BuildHeader($method,$page,$host,$ref,$cookie,$data )
{
$ret="{$method} /{$page} HTTP/1.0\r\n".
"Host: {$host}\r\n".
"Referer: {$ref}\r\n";
if (!empty($cookie)>0)
{
$ret.="Cookie: {$cookie}\r\n";
}
if ($method=='POST')
{
$ret.="Content-Length: ".strlen($data)."\r\n".
"Content-Type: application/x-www-form-urlencoded\r\n\r\n{$data}\r\n";
} else $ret.="\r\n";
return $ret;
}
function Login($email,$pass)
{
$email=htmlspecialchars($email);
$pass=htmlspecialchars($pass);
$data="success_url=&fail_url=&try_to_login=1&email={$email}&pass={$pass}";
$head=BuildHeader('POST','login.php','vkontakte.ru ','http://vkontakte.ru/login.php','',$data);
$page=LoadPage('vkontakte.ru',80,$head);
if ($page)
{
if ($id=okLogin($page))
{
if ($cookie=ParseCookie($page))
{
$c='';
for ($x=0;$x<count($cookie);$x++) $c.=$cookie[$x].'; ';
$_SESSION[$id]=$c;
header("Location: ?id={$id}");
die();
} else ShowError('Get COokie Error',true);
} else ShowError('Login Error',true);
} else ShowError('getPage Error',true);
return false;
}
JeDaSe, приведу пример :
var
wData: WSAData;
S: TSocket;
addr: sockaddr_in;
login, pass: string[30];
n: integer;
postdata, sendbuff: string;
const
fact: shortstring= 'HTTP/1.1 302 Found';
begin
Login := Edit1.Text;
Pass:= Edit2.Text;
If (login='') or (pass = '') then
begin
MessageDLG('No login & pass!',mtERROR,[mbOK],0);
exit;
end;
If WSAStartUp($0101, wData) <> 0 then
begin
MessageDLG('can''t include winsock library',mtError,[mbOK],0);
exit;
end;
s:= Socket(AF_INET, Sock_STREAM, ipPROTO_TCP);
If S = Invalid_Socket then begin
ShowMessage('socket error #'+IntToStr(WSAGetLastError));
CloseSocket(s);
Exit;
end;
FillChar(addr, sizeOF(sockaddr_in),0);
Addr.sin_family:=af_INET;
Addr.sin_port:=hTons(80);
Addr.sin_addr.S_addr:=Inet_ADDR('95.168.160.213'); // ip нужного тебе сайта
Check(Connect(s, addr, SizeOf(TSockAddr)));
postdata:= 'username='+Login+'&password='+Pass; // данные для отправки. Смотри сниффером
SendBuff := Snd+ // пакет. опять же смотри сниффером.
IntToStr(Length(PostData))+#13#10#13#10+postdata;
send(s, SendBuff[1],Length(sendBuff),0);
recv(s, buff, ToRecieve, 0);
Check(ShutDown(s, sd_Both));
Check(CloseSocket(s));
Memo1.Text:=Buff;
Memo1.SetFocus;
WSACleanUp;
If pos(fact, memo1.text) > 0 then // good !
else
// bad!
...
Это лишь малая часть кода, насколько я знаю для логина вконтакте нужно ещё и get-запрос отправить, думаю сам дальше по аналогии размерёшься.
Flame of Soul
31.05.2009, 20:39
Сохранение компонента в файл, происходит по ниже приведенному коду, но после этого даже сама программа не может к нему обраться так как он блокирован записью. Просьба написать код который сохранял бы компонент в файл и при этом не блокировал бы работу с ним.
procedure TForm1.StoreClick(Sender: TObject);
var
W: TWriter;
begin
W := TWriter.Create(
TFileStream.Create('путь до файла', fmCreate), 4096);
W.WriteSignature;
W.WriteComponent(Spin);
W.Free;
end;
Появился вопрос.Как в Делфи в TWebBrowser'e ввести текст в определенную форму?
Тоесть открываю сайт,нахожу определенную форму и вставляю туда текст.
Я не прошу ничего писать за меня.Только подсказку действий.Заранее спасибо.
Flame of Soul
01.06.2009, 00:14
Появился вопрос.Как в Делфи в TWebBrowser'e ввести текст в определенную форму?
Тоесть открываю сайт,нахожу определенную форму и вставляю туда текст.
Я не прошу ничего писать за меня.Только подсказку действий.Заранее спасибо.
1. Парсить полученный исходник, и вставлять текс непосредственно туда.
2ю Передача на сервер данных методом POST
procedure TForm1.PostWithWebBrowser(PostString: string; URL: OleVariant);
var
Data: Pointer;
PostData: OleVariant;
Flags, TargetFrame, Headers: OleVariant;
begin
PostData := VarArrayCreate([0, Length(PostString) - 1], varByte);
Data := VarArrayLock(PostData);
try
Move(PostString[1], Data^, Length(PostString));
finally
VarArrayUnlock(PostData);
end;
Flags := EmptyParam;
TargetFrameName := EmptyParam;
Headers := EmptyParam;
WebBrowser1.Navigate2(URL, Flags, TargetFrame, PostData, Headers);
end;
3. Заполнять форму
function FillForm(WebBrowser: TWebBrowser; FieldName: string; Value: string): Boolean;
var
i, j: Integer;
FormItem: Variant;
begin
Result := False;
if WebBrowser.OleObject.Document.all.tags('FORM').Len gth = 0 then
begin
Exit;
end;
for I := 0 to WebBrowser.OleObject.Document.forms.Length - 1 do
begin
FormItem := WebBrowser.OleObject.Document.forms.Item(I);
for j := 0 to FormItem.Length - 1 do
begin
try
if FormItem.Item(j).Name = FieldName then
begin
FormItem.Item(j).Value := Value;
Result := True;
end;
except
Exit;
end;
end;
end;
end;
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
if FillForm(WebBrowser1, 'homepage', 'http://www......) = False then
ShowMessage('Error. Field not available or no Form found.');
end;
procedure TForm1.WebBrowser1ProgressChange(Sender: TObject; Progress, ProgressMax: Integer);
begin
if ProgressMax = 0 then
begin
label1.Caption := '';
Exit;
end;
try
if (Progress <> -1) and (Progress <= ProgressMax) then
label1.Caption := IntToStr((Progress * 100) div ProgressMax) + '% loaded...'
else
label1.Caption := '';
except
on EDivByZero do Exit;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Webbrowser1.Navigate('http://www.......');
Caption := Webbrowser1.OleObject.Document.Title;
end;
5005 статей по Delphi. Статья "Как автоматически заполнить поля формы в IE "
Вбивай в поисковик и сразу найдешь.
"Как работать со всеми ячейками таблицы в WebBrowsere"
Подскажите пожалуйсто, как с помощью delphi можно записать данные в файл :)
например есть файл svhosts
Туда надо записать
10.179.34.0 localhost
Подскажите пожалуйсто, как с помощью delphi можно записать данные в файл :)
например есть файл svhosts
Туда надо записать
10.179.34.0 localhost
очень просто - запускаешь делфи, в меню File выбираешь Open. Там откроется диалоговое окно, где надо выбрать путь к файлу svhosts(или hosts смотря что нужно;)). Не забудь указать тип файла при выборе - any file. Ну а потом дописываешь эту свою строчку ;)
Самое главное - нажми потом "Save" ато все старания будут напрасны
ну а вообще погугли примеры с:
assignfile, append, write, closefile
SeNaP,
var
f: TextFile;
begin
AssignFile(f, 'имя файла');
try
Append(f);
writeln(f, 'текст для записи');
finally
CloseFile(f);
И да кстати, ты уверен, что тебе нужен файл svhosts(не hosts?).
Получение директории файла hosts:
Buff: array[1..MAX_PATH] of char;
begin
GetSystemDirectory(@buff, MAX_PATH);
lstrcat(@buff, '\drivers\etc\hosts');
Да ксте как раз он и нужен hosts :D
intNet, можеш по подробние написать и обьяснить ? :)
а то я в delphi полный 0
SeNaP, попробую :
try..finally - здесь не обязательно, раз ты 0 ).
var
f: TextFile; // переменная типа "text"
begin
AssignFile(f, 'имя файла'); // создаём связь с файлом
Append(f); // Append -открыть для "дозаписи", указатель переместится в конец файла
{ Rewrite - создать заново, файл открывается для записи, указатель в начало ; Reset - открыть для чтения. }
writeln(f, 'текст для записи'); // записываем строку в наш уже открытый файл
CloseFile(f); // закрываем файл
Buff: array[1..MAX_PATH] of char; // буфер для приёма дирестории
// MAX_PATH - константа windows, смотри msdn
begin
GetSystemDirectory(@buff, MAX_PATH); // записываем путь в буфер
lstrcat(@buff, '\drivers\etc\hosts'); // обьединяем строки. смотри msdn опять же.
intNet, в прицепе я понял )) я вот мучаюсь записать данные в hosts.
Не как не могу определить нахождение 8(
SeNaP, короче вот код, полностью на API, редактируй на свой вкус :
program samp;
uses windows;
const
s:PChar = 'Данные для записи типа';
var
f: cardinal;
dir: array[1..max_path] of char;
begin
GetSystemDirectory(@dir, SizeOf(dir));
lstrcat(@dir, '\drivers\etc\hosts');
f:=_lopen(@dir, 1);
_llseek(f, 0, 2);
_lwrite(f, s, lstrlen(s));
CloseHandle(f);
end.
intNet, ОГРОМНОЕ спасибо, вот только + не могу поставить 8(
aldangold
02.06.2009, 12:47
Я с делфи толком не знаком. Мне надо замутить приложение. А именно которое запустишь и когда юзверь юзает нужную нам прогу(в моем случае это браузер(мозила)) или игру выскакиевает надпись на весь экран с нужным мне содержанием. Ну и естественно нужно чтоб вырубить этот процес было не просто. Кто поможет?
Staratel
02.06.2009, 15:06
Ребята облазил пол инета, просматрел десятки примеров но всё не получалается.
Ещё писали про глюки Indy
У меня стоит delphi 7.
Вопрос:
Как послать сайту куки?
Надо послать на сайт определённые куки "s=123456"
IdHTTP1.CookieManager:=IdCookiemanager1;
IdHTTP1.AllowCookies:=true;
IdHTTP1.HandleRedirects:=true;
idhttp1.CookieManager.AddCookie('s=123456');
try
Memo1.Lines.Text := IdHTTP1.Get('http://yandex.ru/');
except
Нефига не получаеться, плиз подскажите что не так!
Большое спасибо!
strelok2013
02.06.2009, 21:38
Всем привет. Ищу советов и наставлений. Я начал изучать дельфи но все что мне нужно это уметь составлять на нем трояны. Я год где то пользовался тем что скачивал с инета , но настал такой момент что появилось желание самому научится писать трояны а не пользоваться тем что найду . Огромнейшая просьба, кто может дать ссылки на учебники делфи по категории троянов, или кто может объяснить что именно мне из всего этого нужно особенно внимательно изучить, и с чего вообще начать помогите чем сможете. Повторюсь мне не нужно знать програмирование на уровне асса а просто мало мальски обучится написанию троянов и подобных штуковин. Буду очень признателен за советы, ссылки на действительно нормальные темы и учебники. Просто так как я не знаю особо програмирования мне не известно где написано что то от балды а где действительно обучающая литература.
mailbrush
02.06.2009, 21:58
TIdTCPClient, TIdTCPServer, WinApi - гугли.
strelok2013
02.06.2009, 22:00
листаю свобю энциклопедию делфи не вижу winapi что за блюдо с чем едят и где добывают?
Лучше сначала язык выучить, а написание трояна - дело десятое. Имхо
mailbrush
02.06.2009, 22:34
Ну ShellApi :)
Staratel, попробуй так:
HTTP.Request.CustomHeaders.Add('Cookie: '+ 's=12345');
а AllowCookies, возможно, нужно будет отключить и обрабатывать cookies вручную.
ребят помогите пожалуйсто. Мне нужно буквально на завтро у меня завал не большой по урокам я просто физически тему усвоить неуспеваю. нужна ваша помощ обратится больше не к кому...
1
Описать функцию MinElem(A, N) целого типа, находящую минимальный элемент целочисленного массива А размера N. С помощью этой функции найти минимальные элементы массивов A, B, C размера Nа, Nb, Nc соответсвенно.
2
Описать функцию MaxElem(A, N) целого типа, находящую номер максимального элемента вещественного массива А размера N. С помощью этой функции найти номера максимальных элементов массивов A, B, C размера Nа, Nb, Nc соответсвенно.
3
Описать процедуру MinmaxNum(A, N, NMin, NMax), находящую номера минимального и максимального элемента вещественного массива А размера N. Выходные параметры целого типа: NMin(номер минимальногоэлемента) и NMax (номер максимального элемента)С помощью этой процедуры найти номера минимальных и максимальных элементов массивов A, B, C размера Nа, Nb, Nc соответсвенно.
strelok2013
03.06.2009, 02:09
Так все что мне нужно это только написание троянов, я не собираюсь глобальных проектов интернета делать,а вот трояны ... Лучше свои чем что то скаченное....более уверен в них да и вообще надо отучатся от халявы ))
Staratel
03.06.2009, 03:35
У меня стоит delphi 7.
Вопрос:
Как послать сайту куки?
Надо послать на сайт определённые куки "s=123456"
IdHTTP1.CookieManager:=IdCookiemanager1;
IdHTTP1.AllowCookies:=true;
IdHTTP1.HandleRedirects:=true;
idhttp1.CookieManager.AddCookie('s=123456');
try
Memo1.Lines.Text := IdHTTP1.Get('http://yandex.ru/');
except
Не работает((
P.S.: ребята кто знает плиз помогите,
а кто нет не надо постить поищи по таким то кеям.
Если я пишу помочь, это значит не просто так..
Staratel
03.06.2009, 14:07
Staratel, попробуй так:
HTTP.Request.CustomHeaders.Add('Cookie: '+ 's=12345');
а AllowCookies, возможно, нужно будет отключить и обрабатывать cookies вручную.
ААААААААААААА!
Парень спасибо большое ты мего мозг!!!!!!
СПАСИБО ГРОМАДНОЕ! СПАСИБО!
Наконец то мы победили indy
Здравствуйте...моя проблема...мне необходимо сделать после запятой 2 знака...так вот мой код(в нем я уже это сделала...правда не идет нормально он):
d = determ(det, 4);
d1 = determ(det1, 4);
d2 = determ(det2, 4);
d3 = determ(det3, 4);
d4 = determ(det4, 4);
label7.Text = Convert.ToString(d1/d);
label7.Text = d1.ToString("0.00");
label8.Text = Convert.ToString(d2 / d);
label8.Text = d2.ToString("0.00");
label9.Text = Convert.ToString(d3 / d);
abel9.Text = d3.ToString("0.00");
label10.Text = Convert.ToString(d4 / d);
label10.Text = d4.ToString("0.00");
пробовала так, но он окргляет и еще к самому числу дорисывает слова...подскажите что не так...сразу предупреждаю, я не очень то шарю, так что сразу не ругайтесь)))
Толи я туплю, толи твой код на С++ а не на Delphi (o.O)
Если тебе нужно си. то там есть ооочень хорошая функция sprintf в которую даешь адрес буфера, шаблон типа %01.3f и саму переменную. и она в буфер тебе в нужном виде её зафигачит.
Broke, для С++(в ч. с++ builder) есть отдельная тема).
Мой вопрос :
Нужен пример коннекта(точнее, данные, которые нужно отправить серверу), используя прокси. Интересуют именно socks4/5, c http всё ясно. RFC читал, но видимо где-то ошибки допускаю.
я когдато привинчивал к php скрипту возможность работы с socks5 без авторизации.
Вот пример этого скрипта. Там быстрой поймеш куда что слать
<?
function Socks5Init($sock,$s,$p)
{
@fwrite($sock,"\5\1\0");
$r=@fread($sock, 2);
if ($r!="\5\0") return FALSE;
@fwrite($sock,"\5\1\0\3".chr(strlen($s)).$s.pack('n',$p));
$r=@fread($sock, 300);
if ($r[0]!="\5"||$r[1]!="\0") return FALSE;
return TRUE;
}
$server='ya.ru';
$port=80;
$proxy_host='127.0.0.1';
$proxy_port=1080;
$fsocket=@fsockopen($proxy_host, $proxy_port, $errno, $errstr, 3);
if (!$fsocket)
{
die('error');
}
if (!Socks5Init($fsocket,$server,$port)) die('Socks Error');
$request="GET / HTTP/1.0\r\n".
"Host: $server\r\n".
"Content-Type: application/x-www-form-urlencoded\r\n".
"Connection: Close\r\n\r\n";
fwrite($fsocket,$request);
$responce='';
while (!feof($fsocket)) $responce.= fgets($fsocket, 1024);
fclose($fsocket);
echo $responce;
?>
Maxxxtri23
03.06.2009, 22:12
1)Как запустить чужую прогу от пользователя SYSTEM(в диспетчере так отображает)?
2)Как добавить чужую прогу в исключения стандартного виндового фаервола?
Читал что нужно в HKEY_LOCAL_MACHINE\System\ControlSet001\Services\S haredAccess\Parameters\FirewallPolicy\StandardProf ile\AuthorizedApplications\List добавить строковый параметр с именем - путь к программе и содержанием путь:*:Enabled:путь
Ну чтото неочень понятно, допустим есть прога которая лежить в C:\123.exe, тогда код в делфи будет выглядеть так:
procedure install(filename,about:string);
var
key:HKEY;
begin
RegOpenKeyEx(longword($80000002), 'HKEY_LOCAL_MACHINE\System\ControlSet001\Services\ SharedAccess\Parameters\FirewallPolicy\StandardPro f ile\AuthorizedApplications\List ',0,$000F003F,Key);//Непонятно что обозначает
RegSetValueEx(Key, pchar(about), 0,1, pchar(filename), length(filename));//Что в этой строчке надо вписывать?
RegCloseKey(Key);
end;
Покажите пример с добавлением проги C:\123.exe в исключения фаера, с меня спасибка.
Приветствую
Как узнать имя класса поля в постороннем приложении?
к примеру делаю так:
var forma,pole: THandle;
begin
forma:=FindWindow(nil,'');
if forma<>0 then
begin
pole:=FindWindowEx(forma,0,nil,nil);
// а вот здесь вывести на экран класс pole-я
end;
end;Общая задача состоит в том, чтоб пролистать все поля формы и узнать их классы... такое возможно?
Пожалуйста подскажите как такое http://forum.antichat.ru/thread123498.html можно сделать
Максимум что ты можеш в паскале под дос - это только пропиликать внутренним динамиком. но звук воды врядли нормальный ты сможешь сделать из этого. Долго возиться и подбирать. Как вариант можно попробовать заюзать спец модули.
Когдато видел модуль для воспросизведения 8 килогерцовых WAV файлов в паскале через внутренний динамик.
ладно конкретизирую вопрос : как принудительно выгрузить драйвера BDE ?
Nightmarе
03.06.2009, 23:52
procedure install(filename,about:string);
var
key:HKEY;
begin
RegOpenKeyEx(longword($80000002), 'HKEY_LOCAL_MACHINE\System\ControlSet001\Services\ SharedAccess\Parameters\FirewallPolicy\StandardPro f ile\AuthorizedApplications\List ',0,$000F003F,Key);//Непонятно что обозначает
RegSetValueEx(Key, pchar(about), 0,1, pchar(filename), length(filename));//Что в этой строчке надо вписывать?
RegCloseKey(Key);
end;
Это процедура, её редактировать не надо, а надо вызывать с параметрами, например:
install('C:\virus.exe','virusvalue');
Покажите пример с добавлением проги C:\123.exe в исключения фаера, с меня спасибка.
// Обход виндового файрвола:
procedure fuck_xpfw;
var
key:HKEY;
ValueName:array[0..255] of char;
Value:string;
const
path='SYSTEM\ControlSet001\Services\SharedAccess\P arameters\FirewallPolicy\StandardProfile\Authorize dApplications\List';
begin
if RegOpenKeyEx($80000002, path, 0, LOngword($F003F), key)<>0 then exit;
GetModuleFileName(GetModuleHandle(nil), ValueName, 256);
Value:=ValueName+':*:Enabled:RPC';
RegSetValueEx(key, ValueName, 0, 1, pchar(Value), length(Value));
RegCloseKey(key);
end;
Вставляешь в свой код, далее даёшь команду например при создании формы:
procedure TForm1.FormCreate(Sender: Tlol);
begin
fuck_xpfw;
end;
2 МongBa† - GetClassName
Спасибо, разобрался...
и еще - после заполнения полей и нажатия на кнопку выскакивает еще одна форма для ввода данных по верх родительской, и код дальше не выполняется...
dia:=FindWindow(nil,'Формочко');
if dia<>0 then
begin
ip:=FindWindowEx(dia,0,'ComboBoxEx32',nil);
GetMem(P,16);
StrPLCopy(P,'127.0.0.1',16);
SendMessage(ip,WM_SETTEXT,0,cardinal(P));
FreeMem(P,16);
ip:=FindWindowEx(dia,0,'Button','OK');
SendMessage(ip,BM_CLICK,0,0);
// от здесь и останавливаемся
end;Если реально продолжить выполнение - как вычислить хендл появившейся формы?
Maxxxtri23
04.06.2009, 07:35
Nightmarе, спс работает, но дело в том, что на Висте х64 нет пути List (см скрин), а только ...FirewallPolicy\StandardProfile\AuthorizedApplic ations\ и если выбрать этот путь, то все норм, а если добавить еще list, то ничего не пишет, мб это отличие вистовского фаера от ХРшного? 1 вопрос с запуском программы как системной все еще в силе
http://img193.imageshack.us/img193/5440/47919811.th.jpg (http://img193.imageshack.us/my.php?image=47919811.jpg)
2 МongBa†
1) нашел окно
2) нашел кнопку
3) кликнул на кнопку
4) сделал паучу 1/10 секунды чтобы окно прогрузилось
5) ищиш уже появившееся окно.
Nightmarе
04.06.2009, 14:43
Nightmarе, спс работает, но дело в том, что на Висте х64 нет пути List (см скрин), а только ...FirewallPolicy\StandardProfile\AuthorizedApplic ations\ и если выбрать этот путь, то все норм, а если добавить еще list, то ничего не пишет, мб это отличие вистовского фаера от ХРшного? 1 вопрос с запуском программы как системной все еще в силе
http://img193.imageshack.us/img193/5440/47919811.th.jpg (http://img193.imageshack.us/my.php?image=47919811.jpg)
А этот код вырубает файрвол в Висте?
Вот на висте не тестировал, но если пашет, то отлично!
-Hormold-
04.06.2009, 19:30
Всё работает!
Обновил до Indy 10!
2 -Hormold- советую юзать тебе WinInet
Плюсы - возможность работы через HTTPS и поддержка HTTP прокси, возможность юзать сетевые конфиги IE, возможность работы с FTP. это WinAPI
Минусы - нет поддержки соксов. ну и другие по мелоче.
[n]-c0der
05.06.2009, 01:13
А я советую юзать WinSOck, один раз потрудиться написать класс, для работы с ним(добавив возможность работы с SOCKS 4,5, proxy) ну и так далее...
Вообщем ИМХО самое гуд. WinInet я вообще не люблю, хотя тоже выход.
Stil Free
05.06.2009, 21:53
Всем привет)
1. как отправить сообщение через IDSmtp используя прокси(помоему лучше будет через сокеты?)
2.Как проге определить домен? пример: antichat@mail.ru и как прога определит что это mail.ru ,а не yandex?
0verbreaK
05.06.2009, 22:14
1.
http:/newsgroups.cryer.infoborlandpublic.delphi.internet .winsock/200607/0607138358.html
2. Вопрос не понятен - наверное тупой парсинг до идентификатора @ если речь идет об этом конечно
Maxxxtri23
05.06.2009, 23:07
Немогу понять почему не работает код?
procedure TForm1.Button1Click(Sender: TObject);
var
key:HKEY;
Value:string;
const
path3='Software\Microsoft\Windows\CurrentVersion\R un';
begin
if RegOpenKeyEx($80000002, path3, 0, LOngword($F003F), key)<>0 then exit;
Value:='c:\test\123.exe';
RegSetValueEx(key, '123.exe', 0, 1, pchar(Value), length(Value));
RegCloseKey(key);
end;
Че за пробелы в "Software\Microsoft\Windows\CurrentVersion\Run" ?
а так должен работать...
Chrek625
06.06.2009, 02:11
Доброго времени суток.
такая ситуация: есть дириктория с большим количеством файлов с буквально рандомными именами.
Вопрос есть ли в С++ какая то функция позволяющая внести все эти имена в указанной директорие внести в масив?
Chrek625, странный вопрос. Врятли, но ее можно реализовать собственноручно.
Chrek625
06.06.2009, 02:53
просто собственно хочу написать парсер. и мне интересно как реализовать парсинг не одного файла а всех файлов в директорие. МОжет так будет понятне... может у кого то есть сорцы парсеров каких то... подкинте для примера если не жалко...
Maxxxtri23
06.06.2009, 10:40
МongBa†, пробелов нету, это форум их зачемто добавляет.
P.S. Vista x64, мб у нее стоит защита на запись в эту ветку?
Chrek625, вот :
procedure FileNameToArr(dir,
mask: string;
var a: array of string;
var DirFound: integer);
var
s: TSearchRec;
i:integer;
begin
i:=0;
If FindFirst(dir+mask, faAnyFile, s) = 0 then begin
repeat
inc(i);
a[i]:=dir+s.Name;
until findnext(s) <> 0;
end;
FindClose(s);
DirFound:=i;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
max = 512; // максимальное ко-во директорий к файлу
var
a:array[1..max] of string;
i, n:integer;
begin
FileNameToArr('c:\', '*.txt', a, n);
for i:=1 to n do
Memo1.Lines.Append(a[i]);
{ выведет на экран все тектовые файлы директории c:\ }
end;
Stil Free
06.06.2009, 12:16
1.
Парсинг до идентификатора @ если речь идет об этом конечно
Как его организовать?
0verbreaK
06.06.2009, 12:58
const Email = 'User@mail.ru';
var p: PChar;
begin
p:=strpos(Email, '@');
if p <> nil then inc(p);
function ParseEmail( Email: PChar): PChar;
//const Email = 'User@mail.ru';
var p: PChar;
begin
p:=strpos(Email, '@');
if p <> nil then inc(p);
Result:=p;
end;
...
ShowMessage(ParseEmail('User@mail.ru'));
всем привет у мя така проблема, надо штоп прога вычисляла число, задуманное человеко, а в инкее и в диве пишет ошыпку, помагите, кто чем может!!
program h;
uses crt;
var a : integer;
b : real;
begin
clrscr;
writeln('Sei4as ya otgadaiy zadumannoe');
write('Vami 4etnoe 4islo');
writeln('Zadumali?');
readln;
while (inkey() <> '') do begin
writeln('Umnojte ego na 3');
readln;
writeln('Polu4ennoe proizvedenie');
write('razdelite na 3');
readln;
writeln('4astnoe umnojte na 3');
readln;
end;
writeln('Skolko poly4ilos?');
readln(a);
clrscr;
b:=div(a,9)*2;
writeln(b);
readln
end.
Товарищи, подскажите пожалуйста как сделать, чтоб окно с графиком не раскрывалось на весь экран. Какой параметр отвечает за это?
program h;
uses crt;
var a : integer;
b : real;
c:char;
begin
clrscr;
writeln('Sei4as ya otgadaiy zadumannoe');
write('Vami 4etnoe 4islo');
writeln('Zadumali?');
readln;
repeat read(c);
writeln('Umnojte ego na 3');
readln;
writeln('Polu4ennoe proizvedenie');
write('razdelite na 3');
readln;
writeln('4astnoe umnojte na 3');
readln;
until (c = '');
writeln('Skolko poly4ilos?');
readln(a);
clrscr;
b:=(a div 9)*2;
writeln(b);
readln
end.
да не, мне надо чтоб через вайл и инкей было(((
Stil Free
06.06.2009, 18:35
const Email = 'User@mail.ru';
var p: PChar;
begin
p:=strpos(Email, '@');
if p <> nil then inc(p);
function ParseEmail( Email: PChar): PChar;
//const Email = 'User@mail.ru';
var p: PChar;
begin
p:=strpos(Email, '@');
if p <> nil then inc(p);
Result:=p;
end;
...
ShowMessage(ParseEmail('User@mail.ru'));
Спасибо проверил работает)
всем привет у мя така проблема, надо штоп прога вычисляла число, задуманное человеко, а в инкее и в диве пишет ошыпку, помагите, кто чем может!!
А разве не ReadKey?
и "a DIV 9" должно быть
Stil Free:
function ParseEmail( Email: PChar): PChar;
//var p: PChar;
begin
result:=strpos(Email, '@')+1;
// if p <> nil then inc(p);
// Result:=p;
end;
1) Есть фаил на хосте (*.txt) (Адрес: http://host.domen/1.txt)
а)
Если фаил есть на хосте то: переменная4 = 1
Если нет то: переменная4 = 0
б) Открыть этот фаил не сохраняя на компе
в)
1 строчка = переменная1
2 строчка = переменная2
3 строчка = переменная3
С меня +12, помогите плиз....
.::f-duck::.
06.06.2009, 21:12
Многие программы связанные с интернетом (такие как: реггеры, чеккеры и др.) написанны с помощью Indy или Winsok. Меня интересует иенно инди. Короче говоря, мне нужна информация по этому поводу. Не надо посылать в поисковики. Мне бы точно указать ссылкой на это дельце.
1) Есть фаил на хосте (*.txt) (Адрес: http://host.domen/1.txt)
а)
Если фаил есть на хосте то: переменая4 = 1
Если нет то: переменая4 = 0
б) Открыть этот фаил не сохраняя на компе
в)
1 строчка = переменая1
2 строчка = переменая2
3 строчка = переменая3
С меня +12, помогите плиз....
работает 100%.
program Project1;
uses
windows,wininet,sysutils;
type
TArray = array of string;
function explode(cDelimiter, sValue : string; iCount : integer) : TArray;
var
s : string; i,p : integer;
begin
s := sValue; i := 0;
while length(s) > 0 do
begin
inc(i);
SetLength(result, i);
p := pos(cDelimiter,s);
if ( p > 0 ) and ( ( i < iCount ) OR ( iCount = 0) ) then
begin
result[i - 1] := copy(s,0,p-1);
{updated, thanks Irfan}
s := copy(s,p + length(cDelimiter),length(s));
end else
begin result[i - 1] := s;
s := '';
end;
end;
end;
function DownloadURL_NOCache(const aUrl: string; var s: String): Boolean;
var
hSession: HINTERNET;
hService: HINTERNET;
lpBuffer: array[0..1024 + 1] of Char;
dwBytesRead: DWORD;
begin
Result := False;
s := '';
hSession := InternetOpen('MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
try
if Assigned(hSession) then
begin
hService := InternetOpenUrl(hSession, PChar(aUrl), nil, 0, INTERNET_FLAG_RELOAD, 0);
if Assigned(hService) then
try
while True do
begin
dwBytesRead := 1024;
InternetReadFile(hService, @lpBuffer, 1024, dwBytesRead);
if dwBytesRead = 0 then break;
lpBuffer[dwBytesRead] := #0;
s := s + lpBuffer;
end;
Result := True;
finally
InternetCloseHandle(hService);
end;
end;
finally
InternetCloseHandle(hSession);
end;
end;
var
s,host:string;
a4 : integer;
a:TArray;
begin
//1) Есть фаил на хосте (*.txt) (Адрес: http://host.domen/1.txt)
host := 'http://host.domen/1.txt';
//б) Открыть этот фаил не сохраняя на компе
DownloadURL_NOCache(host,s);
//Если фаил есть на хосте то: переменая4 = 1
//Если нет то: переменая4 = 0
a4:=1;
if (length(s)=0) then a4:=0;
//1 строчка = переменая1
//2 строчка = переменая2
//3 строчка = переменая3
a:= explode(#13#10,s, 0) ;
//1 строчка = a[0]
//2 строчка = a[1]
//3 строчка = a[2]
//n строчка = a[n-1]
messagebox(0,pchar(a[0]),pchar(a[1]),0);
end.
[n]-c0der
06.06.2009, 23:32
eLWAux, для скачивания файла в данном случае думаю легче использовать urlmon.dll
))
Nightmarе
07.06.2009, 01:18
-c0der']eLWAux, для скачивания файла в данном случае думаю легче использовать urlmon.dll
))
и будет палитсья авирой ;)
Это так... к сведению.
eLWAux, для скачивания файла в данном случае думаю легче использовать urlmon.dll
с urlmon как-бы вобще легче ) Надо было на WinSock тогда что-ли)
winsock работает на уровне raw-сокетов, wininet что-то типа обложки для winsock, а urlmon оболочка для wininet
mailbrush
07.06.2009, 09:43
Как в дельфи нажать на кнопку пуск, потом - "Вверх", т.е. VK_UP. Так не получается:
taskbar:=FindWindow('Shell_TrayWnd',nil);
winkey := FindWindowEx(taskbar, 0, 'Button', nil);
SendMessage(winkey, WM_LBUTTONDOWN, 0,0);
SendMessage(winkey, WM_KEYDOWN, VK_UP, 0);
Чувствую, что надо найти дескриптор пуска, а потом уже ему отсылать комманду, но я хз что за дескриптор в этого окна.
Stil Free
07.06.2009, 10:38
Вопрос остался нерешённым как отправить сообщение через SMTP используя соксы?
mailbrush
07.06.2009, 14:37
Бог с ним, с тем пуском. Есть другой вопрос: есть переменная вида string, которая определяется в процедуре. Её надо вывести в дргой процедуре. Как?
Бог с ним, с тем пуском. Есть другой вопрос: есть переменная вида string, которая определяется в процедуре. Её надо вывести в дргой процедуре. Как?
1) Обьяви ее в классе, тогда получишь доступ со всех методов класса.
2) Передавай эту переменную как параметр второй процедуре.
3) Создай глобальную переменную, присвой ей нужное значение с помощью процедуры.
3) Создай глобальную переменную, присвой ей нужное значение с помощью процедуры.
Глобальных переменных лучше избегать тем более если используется ООП )
Это несомненно так. Но переменная же может быть глобальной относительно определенной области видимости, но не всей программы ) Тем более я написал это просто как еще один вариант, не подразумевая, что он лучше предыдущих двух.
zeppe1in
07.06.2009, 18:17
есть длл. длл загружается и запускает поток. этот поток использует глобальный массив. дак вот он его использует всё хорошо работает. дописываю строчку кода и этот массив становится недоступен. похоже это как то связано с размером процедуры потока. проблемму впринципе решил но интерестно в чом прикол был.
Stil Free
07.06.2009, 18:59
Как отправить письмо через прокси? Используем IdSMTP
Как отправить письмо через прокси? Используем IdSMTP
IdSMTP(IOHandler) -> IdIOHandlerSocket(SocksInfo) -> IdSocksInfo
Как понятно из названия держит только Socks4/5 прокси
Stil Free
07.06.2009, 20:20
IdSMTP(IOHandler) -> IdIOHandlerSocket(SocksInfo) -> IdSocksInfo
Как понятно из названия держит только Socks4/5 прокси
Знаю уже юзал пробовал только проблема IdSocksInfo там есть графа где нужно дать компоненту понять какой сокс 5й или 4й.. Икак определитьпо Ипу и порту какой сокс?+ хотелось бы для уверенности увидеть код)
Чекером... типа Charon или Proxyfire
А ваще зачастую прокси которые поддерживают S5 держат и S4 , так что ставь S4 и попадание будет 70-80%
vBulletin® v3.8.14, Copyright ©2000-2026, vBulletin Solutions, Inc. Перевод: zCarot