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

[НTL]

Как правильно дернуть куки с Post ответа (Winsock), а потом их отправить в следующим запросе

[wolmer]

Как правильно дернуть куки с Post ответа (Winsock), а потом их отправить в следующим запросе
Как принять куки (там есть вариант, куки от хедера берутся):
http://forum.antichat.ru/showpost.php?p=788789&postcount=11

[НTL]

Как принять куки (там есть вариант, куки от хедера берутся):
http://forum.antichat.ru/showpost.php?p=788789&postcount=11

Есть, но не понятно как она работает

[wolmer]

Есть, но не понятно как она работает
А че не понятного то? Разжевываю по порядку! :)

В мемо1:
maska=aallalaalala;session=ashhasha;lala=2481;

function Tform1.CopyCookie(s,sBuff:string):string;
var
text:string;
i:integer;
Begin
text:='';
showmessage(inttostr(pos(s+'=',sBuff)));
showmessage(inttostr(Length(sBuff)));
//Посл символ у нас под номером 45
For i:=pos(s+'=',sBuff) to Length(sBuff) Do
//в i записываем откуда начинается фраза "what="
//(В мемо1 у меня начинается фраза с 20 символа)
//(в дальнейшем будет сокр МПК - МестоПоложениеКуки)
//Дальше идем от МПК до символа ";" (когда сод. куки обрывается)
//Но мы не знаем где будет находится символ ";"
//Поэтому будем проходится от МПК до посл. символа sbuff (в намем случае до посл. символа memo1)
Begin
If sBuff[i]<>';' then text:=text+sBuff[i] else Break;
//Тут мы сверяем текущий символ с символом ";"(окончание куки)
//Если этого ";" символа нету то добавляем символ
//В итоге как символ ";" встретился то у нас в переменной text будет кука (кука+значение куки)
//и мы закончим проходится цикл так как уже кука у нас есть и нам не зачем дальше проходиться
End;
Result:=text;
End;

В Button1.OnClick пишем:
ShowMessage('Наша кука+значение куки: '+CopyCookie('What',Memo1.Lines.Text));

Все просто если подумать головой

[Markus_13]

Кто знает - можно как-нить изменить BorderStyle чужого окна?
Скорее всего с помощью SendMessage я думаю, но найти не могу... :confused:

[НTL]

А че не понятного то? Разжевываю по порядку! :)

В мемо1:
maska=aallalaalala;session=ashhasha;lala=2481;

function Tform1.CopyCookie(s,sBuff:string):string;
var
text:string;
i:integer;
Begin
text:='';
showmessage(inttostr(pos(s+'=',sBuff)));
showmessage(inttostr(Length(sBuff)));
//Посл символ у нас под номером 45
For i:=pos(s+'=',sBuff) to Length(sBuff) Do
//в i записываем откуда начинается фраза "what="
//(В мемо1 у меня начинается фраза с 20 символа)
//(в дальнейшем будет сокр МПК - МестоПоложениеКуки)
//Дальше идем от МПК до символа ";" (когда сод. куки обрывается)
//Но мы не знаем где будет находится символ ";"
//Поэтому будем проходится от МПК до посл. символа sbuff (в намем случае до посл. символа memo1)
Begin
If sBuff[i]<>';' then text:=text+sBuff[i] else Break;
//Тут мы сверяем текущий символ с символом ";"(окончание куки)
//Если этого ";" символа нету то добавляем символ
//В итоге как символ ";" встретился то у нас в переменной text будет кука (кука+значение куки)
//и мы закончим проходится цикл так как уже кука у нас есть и нам не зачем дальше проходиться
End;
Result:=text;
End;

В Button1.OnClick пишем:
ShowMessage('Наша кука+значение куки: '+CopyCookie('What',Memo1.Lines.Text));

Все просто если подумать головой

:) Но только я заголовки кук не знаю

[=Zeus=]

Кто знает - можно как-нить изменить BorderStyle чужого окна?
Скорее всего с помощью SendMessage я думаю, но найти не могу... :confused:

BorderStyle я тоже не нашел, но нарыл у себя следующий код:

procedure TForm1.Button1Click(Sender: TObject);
var h: HWND;
rgn: HRGN;
rect: TRect;
begin
h:=FindWindow(nil, PChar('Безымянный - Блокнот'));
GetWindowRect(h, rect);
rgn := CreateRoundRectRgn(0, 0, rect.Right-rect.Left, rect.Bottom-rect.Top, 50 , 50);
SetWindowRgn(h, rgn, True);
end;
Здесь мы ищим дескриптор окна с названием "Безымянный - Блокнот", после чего определяем его размер и создаем округлую область. Финальный штрих - и окно приобретает очертания нашей области, тоесть как-бы с заокруглеными углами. Это конечно не то, что ты хотел, но как вариант...
Можно создать квадратную область и скрыть границы окна. Хотя уверен, что и с BorderStyle найдется решение.

[Markus_13]

=Zeus=, Спасибо конечно))
но смысла в этом не вижу, мне нужно сделать чтобы окну нельзя было менять размер, также чтобы окно нельзя было разворачивать на полный экран, а регион тут не причем :rolleyes:
З.Ы. никто незнает где найти описание всех параметров SendMessage? в SDK нифига найти немогу, хочется всетаки сделать красиво, а поменять BS на ToolWindow имхо лучший вариант...

[Nullsleep]

var
wnd: HWND;
old_long: Integer;
begin
wnd := FindWindow('Notepad', nil);
old_long := GetWindowLong(wnd, GWL_STYLE);
SetWindowLong(wnd, GWL_STYLE, old_long and not
(WS_MAXIMIZEBOX or WS_SIZEBOX));
end;

а вообще, посмотри все константы, начинающиеся с "WS_"

[Markus_13]

там все даже проще оказалось, вот как сделал:
var wh:hWnd;
...
SetWindowLong(wh,GWL_STYLE,WS_SYSMENU or WS_GROUP or WS_CAPTION);
ShowWindow(wh,0);ShowWindow(wh,1);
но ToolWindow не нашел всеравно)

[Nullsleep]

там все даже проще оказалось, вот как сделал:
Но твой код не сохраняет атрибутов, которые были у окна раньше.

но ToolWindow не нашел всеравно)
Плохо смотришь ;)
WS_EX_TOOLWINDOW
Но для него нужно сменить GWL_STYLE на GWL_EXSTYLE. Примерно так:

var
wnd: HWND;
old_long: Integer;
begin
wnd := FindWindow('Notepad', nil);
old_long := GetWindowLong(wnd, GWL_EXSTYLE);
SetWindowLong(wnd, GWL_EXSTYLE, old_long or WS_EX_TOOLWINDOW);
end;

[Flenov]

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

Внимание вопрос:

Существует главный юнит (юнит главной формы), в нём существует определйнная функция.
Существует Юнит потока (TThread) из которого вызывается та функция.
Где она будит выполняться?
а) В главном юните.
б) В юните потока.

[Nullsleep]

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

[cremator (c)]

sleep(1) надо в поток добавлять

[InfectedM]

ВОПРОС: как останавливать возобновлять поток созданный через:

var
th:cardinal;
h:integer;
begin //

h := beginthread(nil, 1024, @sending1, nil, 0, th);
end;

[Nullsleep]

sleep(1) надо в поток добавлять
Я как раз наоборот пытался увидеть зависание на форме, так что Sleep() тут не нужен.

[Nullsleep]

InfectedM: beginthread все равно сводится к винапишной функции CreateThread, так что лучше использовать её. Тем более вместе с ней можно юзать SuspendThread и ResumeThread (приостановить и продолжить выполнение потока).

[Flenov]

Доброго времени суток!

Я на Delphi пишу одну програмку.
Она проходит авторизацию, получает какие-то куки.
Ну например вот фрагмент ответа сервера:


Set-Cookie: par1=val1; expires=Sun, 22-Aug-2010 22:38:14 GMT; path=/; domain=.domain.ru
Set-Cookie: par2=val2; expires=Sat, 04-Sep-2010 08:38:06 GMT; path=/; domain=.domain.ru
Set-Cookie: par3=val3; expires=Sat, 04-Sep-2010 08:50:26 GMT; path=/; domain=.domain.ru



После чего я хочу использовать эти куки, но видимо что-то не так делаю.
Ниже текст HTTP запроса.
Куда правильно присоединить эти куки?
Если запрос не правильный, подправьте пожалуйста.
Заранее спасибо!

'GET '+WebAddr+' HTTP/1.0'+#13#10+
'Accept: text/html, */*'+#13#10+
'Host: '+Server+#13#10+
'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; .NET CLR 1.1.4322; .NET CLR 2.0.50727)'+#13#10+
'Content-Type: text/html'+#13#10#13#10;

[dos999]

Полностью поддерживаю Nullsleep в его совете о использовании CreateThread но раз уж так хочется можно делать так:

var
th:cardinal;
h:integer;
begin //
h := beginthread(nil, 1024, @sending1, nil, 0, th);
SuspendThread(h);//приостановить
ResumeThread(h);//продолжить
end;

[wolmer]

Доброго времени суток!

Я на Delphi пишу одну програмку.
Она проходит авторизацию, получает какие-то куки.
Ну например вот фрагмент ответа сервера:


Set-Cookie: par1=val1; expires=Sun, 22-Aug-2010 22:38:14 GMT; path=/; domain=.domain.ru
Set-Cookie: par2=val2; expires=Sat, 04-Sep-2010 08:38:06 GMT; path=/; domain=.domain.ru
Set-Cookie: par3=val3; expires=Sat, 04-Sep-2010 08:50:26 GMT; path=/; domain=.domain.ru



После чего я хочу использовать эти куки, но видимо что-то не так делаю.
Ниже текст HTTP запроса.
Куда правильно присоединить эти куки?
Если запрос не правильный, подправьте пожалуйста.
Заранее спасибо!

'GET '+WebAddr+' HTTP/1.0'+#13#10+
'Accept: text/html, */*'+#13#10+
'Host: '+Server+#13#10+
'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; .NET CLR 1.1.4322; .NET CLR 2.0.50727)'+#13#10+
'Content-Type: text/html'+#13#10#13#10;

В мемо1:
maska=aallalaalala;session=ashhasha;lala=2481;

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

Код принятия кукисов:
function Tform1.CopyCookie(s,sBuff:string):string;
var
text:string;
i:integer;
Begin
text:='';
showmessage(inttostr(pos(s+'=',sBuff)));
showmessage(inttostr(Length(sBuff)));
//Посл символ у нас под номером 45
For i:=pos(s+'=',sBuff) to Length(sBuff) Do
//в i записываем откуда начинается фраза "what="
//(В мемо1 у меня начинается фраза с 20 символа)
//(в дальнейшем будет сокр МПК - МестоПоложениеКуки)
//Дальше идем от МПК до символа ";" (когда сод. куки обрывается)
//Но мы не знаем где будет находится символ ";"
//Поэтому будем проходится от МПК до посл. символа sbuff (в намем случае до посл. символа memo1)
Begin
If sBuff[i]<>';' then text:=text+sBuff[i] else Break;
//Тут мы сверяем текущий символ с символом ";"(окончание куки)
//Если этого ";" символа нету то добавляем символ
//В итоге как символ ";" встретился то у нас в переменной text будет кука (кука+значение куки)
//и мы закончим проходится цикл так как уже кука у нас есть и нам не зачем дальше проходиться
End;
Result:=text;
End;

В Button1.OnClick пишем:

ShowMessage('Наша кука+значение куки: '+CopyCookie('What',Memo1.Lines.Text));

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

План примерно таков:
-Отправляем пакет (без кукисов)
--Принимаем ответный пакет (ответный ответ придет с кукисами если отправляли на авторизацию пакет)

-Отправляем пакет с кукисами, к примеру:
sendbuff :='GET vkontakte.ru/id1 ' HTTP/1.1'+ #13#10 +
'Host: vkontakte.ru'+ #13#10 +
'User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.8.1.14) Gecko/20080404 AdCentriaIM/1.7 Firefox/2.0.0.14 WebMoney Advisor'+ #13#10 +
'Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5'+ #13#10 +
'Accept-Language: ru-ru,ru;q=0.8,en-us;q=0.5,en;q=0.3'+ #13#10 +
'Accept-Encoding: gzip,deflate'+ #13#10 +
'Accept-Charset: windows-1251,utf-8;q=0.7,*;q=0.7'+ #13#10 +
'Keep-Alive: 300'+ #13#10 +
'Connection: keep-alive'+ #13#10 +
'Referer: http://vkontakte.ru/index.php'+ #13#10 +
'Cookie: '+CopyCookie('remixchk',sBuff)+';'+' '+CopyCookie('remixmid',sBuff)+';'+' '+CopyCookie('remixemail',sBuff)+';'+' '+CopyCookie('remixpass',sBuff)+ #13#10+ #13#10;

--Принимаем ответный пакет

[Flenov]

CopyCookie('remixpass',sBuff)

Мудрёно ты сделал.
Но всёравно спасибо!


Короче кукиса идут вот так:

GET WebAddr HTTP/1.0
Accept: text/html, */*
Host: WebServer (or Domain)
User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; .NET CLR 1.1.4322; .NET CLR 2.0.50727)
Cookie: Param1=Value1; Par2=Value2; ParN=ValueN;


Впринципе, кукиса могут ити без пробелов.

[righter]

Есть сайт толковый который хранит информацию о биржевых транзакциях - http://www.finam.ru/analysis/export/default.asp На звпрос пользователя он генерирует файл отчет, динамически. Есть потребность автоматизировать процесс т.е. з задаными парамертами скачивать данные для множества акций. Чтобы пограммка написанная на делфе акуратно копировала эти файлы в нужную мне папку. Наставте меня на путь вреный и легкий. Делфу знаю давно вебдизайн тоже, а вот такими вещами еще не занимался.

[НTL]

Как с помощью Winsock передать картинку на антикапчу?

[crawen_s]

как запрограмировать вычисление функции z = x16 (x в 16 степени), с использованием наименшего количества операций умножения ??? :)

[НTL]

как запрограмировать вычисление функции z = x16 (x в 16 степени), с использованием наименшего количества операций умножения ??? :)

a := 1;
for i := 1 to 20 do a := a * 2;

[slesh]

x := x * x; => x^2
x := x * x; => x^4
x := x * x; => x^8
y := x * x; => x^16


или как вариант
такой метод удобен когда показатель степени явзяется степенью числа 2. т.е. 16 - это 2^4



for z:=1 to sqrt(16) do x := x * x;
y := x;



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

А в твоем случае получилосьбы 16 умножений )

[crawen_s]

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

[transserg]

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

[НTL]

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

После каждой строчки напиши: Memo1.lines.add('1');

[transserg]

После каждой строчки напиши: Memo1.lines.add('1');
и как узнать где же оно тормозит? из твоего совета?
это не выход к тому же нет memo в программе и не будет его там!

[Ra$cal]

лол жгучий вариант.
смотри в сторону апи GetTickCount

[cel1697i845]

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

Заранее спасибо.(буду признателен за предложенную литературу по этому и подобным вопросам)
P.S. Еще раз спасибо.

[transserg]

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

[Retro]

Вот так z := exp(16* ln(x)) ?

[Flenov]

Всё мне не имётся, всё я страдаю хернёй.
На этот раз приспичило написать прожку для скачки всяких мелких файлов (ну допустим картинка *.jpg килобайтов на 27).
Само собой WinSock2 в зубы и вперёд.
Но облом меня ждал самый интересный даже если отцепить заголовок, и побайтово писать в файл, всёравно получается херня.
Погуглил, тоже люди сталкивались с такой проблеммой, но конкретных ответов нет.

Наверняка кто-то из вас писал подобное.
Подскажите пожалуйста, какие тут хитрости?
Или может файл надо по частям просить?
Заранее спасибо.
Как обычно за хороший ответ ставлю плюсы.

[AKYLA]

Ламерский вопрос по строкам.
Нужно в MEMO к примеру добавить мои символы(строка) вначале и в конце строк, загруженного текстового файла. Что-то я такую простую вещь недопираю.
Толи нужно это делать в отдельном StringList и потом перезаписывать в MEMO, то ли по другому как-то....

Черкните плиз кому не лень :)

[AKYLA]

Flenov
Ну так в чем проблема, качни например ICS - Internet Component Suite (можно и indy и сокеты но мне больше этот компонет по душе)
И наваяй типа:

procedure TForm1.Button1Click(Sender: TObject);

begin

Button1.Enabled:=False;
Edit1.Enabled:=False; //т

HttpCli1.URL := Label4.Caption; //тут твой урл надо типа Edit впихнуть
HttpCli1.RcvdStream := TFileStream.Create(Edit1.Text, fmCreate); //тут типа куда сохранять Edit1.Text
try
try
HttpCli1.Get;
Label2.Caption := 'Загружено ' +
intToStr(HttpCli1.RcvdStream.Size) + ' bytes';
except
on E: EHttpException do begin
Label7.Caption := 'Ошибка : ' +
IntToStr(HttpCli1.StatusCode) + ' ' +
HttpCli1.ReasonPhrase;;
end
else
raise;
end;
finally
Button1.Enabled := TRUE;
AbortButton.Enabled := FALSE; //кнопка отмены
HttpCli1.RcvdStream.Destroy;
HttpCli1.RcvdStream := nil;
end;
end;

Если я правильно понял что ты хочешь :)

[RumShun]

2 AKYLA

var
s:string;
i:integer;
begin
for i:=0 to memo1.lines.count-1 do
begin
s:=memo1.lines[i];
//делаеш чево то там с s
memo1.lines[i]:=s;
end;
end;

ну гдето так, в компиляторе не проверял, писал на коленке.

[AKYLA]

RumShun
Нет так просто заменяется во всех строчках на s, а старое стирается.
А нужно определять начало и конец каждой строки и добавлять S в начало или в конец

[Nullsleep]

AKYLA:

const
b = '<begin>';
e = '<end>';
var
s: string;
i: Integer;
begin
for i := 0 to Memo1.Lines.Count-1 do
begin
s := Memo1.Lines[i];
Memo1.Lines[i]:=b+s+e;
end;
end;

[AKYLA]

Nullsleep
Блин точно, можно же так просто...а то я заморочился с поиском конца строки и.т.д )))
Спасибо :) что-то мозг совсем стареет )))

[Tombik]

Ребята, нужна нубовская помощь в аське по Делфи, огромная просьба, постучите http://ru-test.com/icq.JPG

[wolmer]

Покраска ячейки StringGrid без DrawCell. Как это реализовать программно?

Событие DrawCell в моем случае не идет (хочу чтобы красило там где выделенна ячейка(StringGrid))

[Ixidor]

Писал программу, столкнулся с такой проблемой. При открытии определенного сайта определенным браузером:



ShellExecute(Handle, 'open',
'c:\Program Files\Mozilla Firefox\firefox.exe', 'http://rambler.ru', nil,
SW_HIDE);

почему-то не работает SW_HIDE, т е окно показывается совершенно обычным образом. Это происходит со всеми сайтами. Кто-нибудь знает, почему так происходит? Можете что-либо посоветовать? Заранее спасибо!

[Flenov]

Flenov
Ну так в чем проблема, качни например ICS - Internet Component Suite (можно и indy и сокеты но мне больше этот компонет по душе)
И наваяй типа:


С готовым компонентом и дурак сможет.
А вот на чистых сокетах как?
Впринципе меня интересует какой нужен заголовок запроса (обычный GET или тут особенная специфика) и особенно интересует приёмка файла.

[wolmer]

Писал программу, столкнулся с такой проблемой. При открытии определенного сайта определенным браузером:



ShellExecute(Handle, 'open',
'c:\Program Files\Mozilla Firefox\firefox.exe', 'http://rambler.ru', nil,
SW_HIDE);

почему-то не работает SW_HIDE, т е окно показывается совершенно обычным образом. Это происходит со всеми сайтами. Кто-нибудь знает, почему так происходит? Можете что-либо посоветовать? Заранее спасибо!

winexec(PChar('cmd /c "c:\Program Files\Mozilla Firefox\firefox.exe" http://rambler.ru/'),SW_Hide);

Тестировал сейчас, все нормально работает :) (через командную строку открывает)

[Ixidor]

Тестировал сейчас, все нормально работает :) (через командную строку открывает)

Все это очень странно. У меня окно все так же видно как и функцией shellExecute=((( А у тебя оно точно невидимо было?

[wolmer]

почему-то не работает SW_HIDE, т е окно показывается совершенно обычным образом Это происходит со всеми сайтами. Кто-нибудь знает, почему так происходит?

Что значит обычным? Я этого не понимаю

[Ixidor]

параметр SW_HIDE отвечает за невидимость окна. Однако окно, почему-то, невидимым не получается. И это происходит именно при открытии определенного сайта браузером. Например, при открытии текстого документа блокнотом так окно сделать невидимым получалось...

[=Zeus=]

параметр SW_HIDE отвечает за невидимость окна. Однако окно, почему-то, невидимым не получается. И это происходит именно при открытии определенного сайта браузером. Например, при открытии текстого документа блокнотом так окно сделать невидимым получалось...
Какую ф-цию используешь? Как хендл ищеш? По заголовку? И вообще, какое именно окно ты пытаешся скрыть? Опиши подробней.

[Ixidor]

Писал программу, столкнулся с такой проблемой. При открытии определенного сайта определенным браузером:



ShellExecute(Handle, 'open',
'c:\Program Files\Mozilla Firefox\firefox.exe', 'http://rambler.ru', nil,
SW_HIDE);

почему-то не работает SW_HIDE, т е окно показывается совершенно обычным образом. Это происходит со всеми сайтами. Кто-нибудь знает, почему так происходит? Можете что-либо посоветовать? Заранее спасибо!

Вот описание проблемы. Я хочу сделать окно сразу невидимым(при открытии). Использую функцию ShellExecute

[Nullsleep]

wolmer, а такой код не работает?

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if gdSelected in State then
with StringGrid1.Canvas do
begin
Font.Color := clBlack;
Brush.Color := $0ec2ff;
FillRect(Rect);
TextOut(StringGrid1.DefaultColWidth*ACol+3,
StringGrid1.DefaultRowHeight*ARow+4, StringGrid1.Cells[ACol, ARow]);
end;
end;

[Nullsleep]

Ixidor, попробуй такой код

const
cmd = 'C:\Program Files\Mozilla Firefox\Firefox.exe http://rambler.ru';
var
start_inf: _STARTUPINFOA;
proc_inf : _PROCESS_INFORMATION;
begin
FillChar(start_inf, SizeOf(start_inf), 0);
start_inf.cb := SizeOf(start_inf);
start_inf.dwFlags := STARTF_USESHOWWINDOW;
start_inf.wShowWindow := SW_HIDE;
CreateProcess(nil, cmd, nil, nil, True, 0, nil, nil, start_inf, proc_inf);
end;

[Ixidor]

Nullsleep, все равно окно видимое=( А у тебя его не видно?

[Nullsleep]

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

[transserg]

Привет всем! нужно сделать кеширование данных в файле в одном файле!!! как лучше арганизовать это? данные будут иконки

[Ixidor]

NullSleep, какая у тебя ОС и какой браузер?)) Конечно, я могу скрыть браузер после запуска, но это некошерно. Можно ли получить хендл окна уже при запуске и скрыть его одновременно с запуском?

[=Zeus=]

NullSleep, какая у тебя ОС и какой браузер?)) Конечно, я могу скрыть браузер после запуска, но это некошерно. Можно ли получить хендл окна уже при запуске и скрыть его одновременно с запуском?
Можно получить хендл когда окно открыто (FindWindow помоему). Можно по заголовку.

[Ixidor]

Не, это я знаю. Я хотел получить хендл одновременно с открытием=)

[AKYLA]

Flenov
Ну тогда попробуй это:

Function DownloadBFile(P: Pointer): Longint; Stdcall;
Const
CrLf: String = #$0d+#$0a;
Var
Fn: String;
F: File;
GetOut: Boolean;
WSAData: TWSAData;
hp: phostent;
a: tsockaddr;
IpAddress,Buffer: String;
Ts,Bs,Br,ContentLength,I: Integer;
MySock: TSocket;
Begin
Fn:=String(P^);
// ShowMessage('Attempting To Download File '+Fn);
WSAStartup($0101, WSAData);
mysock := socket(AF_INET, SOCK_stream, ipproto_tcp);
hp := gethostbyname('www.google.com'); //Сайт
Sleep(40);
if hp = nil then
begin
// ShowMessage('Could Not Resolve Name...');
exit;
end
else
begin
for i := 0 to hp^.h_length - 1 do
IPAddress:=IpAddress+IntToStr(Ord(Hp.h_addr_list^[i]))+'.';
SetLength(IPAddress,Length(IPaddress)-1);
end;
a.sin_family := AF_INET;
a.sin_port := htons(80);
A.sin_addr.S_addr:=inet_addr(Pchar(IpAddress));
I:=connect(mysock, a, sizeof(a));
buffer:='GET /test/'+fn+' HTTP/1.0'+CrLF+'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-excel, application/msword, */*'+CrLF+'Accept-Language: en-au'+CrLF+'Accept-Encoding: gzip, deflate'+CrLF+'User-Agent: Mozilla/4.0 (compatible; MSIE 5.01; Windows NT 5.0)'+CrLF+'Host: '+IpAddress+CrLF+'Cache-Control: no-cache'+CrLf+'Connection: Close'+CrLF+Crlf;
I:=send(mysock, Buffer[1], Length(buffer), 0);
Sleep(30);
System.Assign(F,'c:\image.gif'); // Картинка куда сохранять
System.Rewrite(F,1);
ContentLength:=0;
SetLength(Buffer,5048);
FillChar(Buffer[1],Sizeof(Buffer),#0);
BS:=recv(mysock, buffer[1], 5048,0);
If (BS=Socket_Error) Or (BS=0) Then
Exit;
TS:=0;
BS:=0;
If (Copy(Buffer,1,15)='HTTP/1.1 200 OK') or (Copy(Buffer,1,15)='HTTP/1.0 200 OK') Then
Begin
Delete(Buffer,1,Pos('Content-Length:',Buffer)+15);
ContentLength:=StrToInt(Copy(Buffer,1,Pos(#$0d+#$0 a,Buffer)-1));
Delete(Buffer,1,pos(#$0d+#$0a+#$0d+#$0a,Buffer)+3) ;
Form1.ProgressBar1.Max:=ContentLength div 1024;
If Trim(Buffer)<>'' Then
Begin
TS:=TS+Length(Buffer);
BlockWrite(F,Buffer[1],Length(Buffer));
SetLength(Buffer,5048);
End;
End
else
Exit;
Repeat
SetLength(Buffer,5049);
BS:=recv(mysock, buffer[1], 5048,0);
TS:=TS+Bs;
Form1.ProgressBar1.Position:=TS div 1024;
BlockWrite(F,Buffer[1],BS);
Until (BS=0) OR (Socket_Error=BS) Or (GetOut=True);
System.Close(F);
// Конец закачки;
End;

procedure TForm1.Button1Click(Sender: TObject);
Var
Th: Thandle;
begin
F:='mage.gif'; //Картинку которую качать
CreateThread(Nil,0,@DownloadBFile,@F,0,Th);
end;

П.С, Дурак он на то и дурак, что ничего вообще не знает )))

[shuba]

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

вот кароче часть кода :D

Begin writeln('vvedi chislo'); readkn(x.y); writeln('vvedite deystvie'); readln (d) if d='+' then z:= x+y

т.е сделать в общем надо простой калькулятор,но с сюрпризом...
ф-ции:
1)чтоб делил, складывал и умножал...больше ниче ненадо
2)Сюрприз заключаеться в том...чтобы когда кто нить на 0 делил...в консоле писалось ERROR и комп ребутался)))))

Если не трудно напишите пожалуто...если можно...скомпилируйте))))Буд� � очень благодарен!

[Ixidor]

Никто не знает, как эмулировать нажатия клавиш в браузерную строку? Хендл окна браузера известен.

[Dosia]

Имхо смотреть надо в сторону SendMessage

RE: Кароче в школе задали

Скомпилированный калькулятор и исходники тут (http://dump.ru/file/3363645) . После того как попробуют разделить на 0 сообщаем "Error ...", после чего ждем 2 секунды и shutdown.

[AKYLA]

Ixidor
Что-то типа такого для фаера

uses ddeman;

function GetURL(Browser: string): string;
var
Client_DDE: TDDEClientConv;
temp: PChar;
begin
Result := '';
Client_DDE:= TDDEClientConv.Create( nil );
with Client_DDE do
begin
SetLink(Browser, 'WWW_GetWindowInfo');
temp := RequestData('0xFFFFFFFF');
Result := StrPas(temp);
// Return only the URL part
Delete(Result, Pos(',', Result), Length(Result)-Pos(',', Result)+1);
// Remove quotes
Delete(Result, 1, 1);
Delete(Result, Length(Result), 1);
// ************
StrDispose(temp);
CloseLink;
end;
Client_DDE.Free;
end;

procedure SetURL(URL, Browser: String);
var
Client_DDE: TDDEClientConv;
begin
Client_DDE := TDdeClientConv.Create(nil);
with Client_DDE do
begin
SetLink( Browser, 'WWW_Activate' );
RequestData('0xFFFFFFFF');
SetLink( Browser, 'WWW_OpenURL' );
RequestData(URL + ',,0xFFFFFFFF,0x3,,,');
CloseLink;
end;
Client_DDE.Free;
end;

//Вызов
SetURL('http://forum.sources.ru/','FireFox');

[UnknownZZZ]

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

HCBT_DESTROYWND:
begin GetWindowText(WParam,@WindowName,MAX_PATH);
if WindowName='' then exit;
NewStr:='Window destoyed at '+GetTime; NewStr:=NewStr+'. Window name '+WindowName+#13#10;
if WindowName='NetSpeakerphone' then //ето условие определяет закрылось ли окно,
надо ели закрылось, то спрятать кнопку на форме
end;

[Kornero]

Подскажите пожалуйста как подключить к проекту свои курсоры???!!!
Весь день бьюсь нихрена не выходит...

[Dosia]

procedure TForm1.FormCreate(Sender: TObject);
var
h: hcursor;
begin
h := LoadCursorFromFile('C:\windows\cursors\sizenwse.an i');
Screen.Cursors[1] := h;
Form1.Cursor := 1;
end;

[Kornero]

Не работает такой вариант...

пробовал и cur и ani файлы...выскакивает какая-то левая ошибка...

Access violation at address 00E390A4 in module 'MyDLL'. Read of address 0000007C.

[wolmer]

2) путь как-то странно указан, что за i в конце?

А что? Путь до системной папки виндувс (замени на твой путь), дальше из нее загружает картинку курсора (токо там без пробела в конце пути)

[Kornero]

Я весь день мучаюсь...и рес файлы создавал и пытался подобным образом подключить напрямую...может есть ещё способы импорта сторонних курсоров?

P.S. Ошибка происходит при
Form1.Cursor := 1;

P.P.S. Юзаю Делфи 2006...может она у меня какая палёная?...

[mr. ZetRikS]

Я весь день мучаюсь...и рес файлы создавал и пытался подобным образом подключить напрямую...может есть ещё способы импорта сторонних курсоров?

P.S. Ошибка происходит при
Form1.Cursor := 1;

P.P.S. Юзаю Делфи 2006...может она у меня какая палёная?...

Если мне не изменяет память то:
Screen.Cursors[1] := LoadCursorFromFile('mycursor.ani');
Screen.Cursor := 1;

Где mycursor.ani это твой курсор в папке с программой...

Немного поискал и наткнулся на линк (http://www.delphisources.ru/pages/faq/base/own_cursors.html)
после изучения которого думаю многое прояснится...

Ещё один линк в тему (http://deldev.blogspot.com/2008/12/delphi.html)

[miqo]

Как можно с помощю компонента TComPort прочитать сроку с порта.Надо что бы программа читала все время и если что то получила должна добавить в Memory. Пробовал comport.readstring но не помогает. помогите

[ZdezBilYa]

Вопрос:
Делаю запрос через браузер. Ответ:

HTTP/1.1 200 OK
Server: nginx/0.7.41
Date: Tue, 08 Sep 2009 08:04:54 GMT
Content-Type: text/html; charset=windows-1251
Content-Encoding: gzip
Cache-Control: no-cache,no-store,must-revalidate
Pragma: no-cache
Expires: Mon, 08 Sep 2008 08:04:54 GMT
Last-Modified: Tue, 08 Sep 2009 12:04:54 GMT
Vary: Accept-Encoding
Content-Length: 16761
Via: 1.1 inet
Proxy-Connection: close
...
...

Все нормально

Делаю запрос через программу.
Ставлю AcceptEncoding:='deflate, gzip, x-gzip, identity, *;q=0';
В снифере нормально, в программе:
‹
Если ставить AcceptEncoding:='deflate, identity, *;q=0';
то ошибка идет:

HTTP/1.1 501 Not Implemented (Proxy server error)
Via: 1.1 inet
Proxy-Connection: close
Content-Type: text/html; charset=windows-1251
Content-Length: 435
...
...


Как всё-таки получить ответ в программе?

[slesh]

вообще убрать строчку AcceptEncoding и пусть данные преедаются в обычном, неупакованном виде

[ZdezBilYa]

вообще убрать строчку AcceptEncoding и пусть данные преедаются в обычном, неупакованном виде
без нее тоже:
HTTP/1.1 501 Not Implemented (Proxy server error)
Via: 1.1 inet
Proxy-Connection: close
Content-Type: text/html; charset=windows-1251
Content-Length: 435

[UnknownZZZ]

ребят....помогите с длл)))

[iGlass]

Всем доброго времени суток!

У меня есть вопрос :

Можно ли каким нибудь образом инициализировать службу telnet и задать ей два параметра Логин и пароль, ну допустим логин: user пароль: 0000 ?

Ну допустим при создание формы в событии OnCreate

[iGlass]

Вот ещё вопрос.. Опишите какой нибудь самый простой метод парсинга html кода...

Заранее благодарен

[НTL]

Вот ещё вопрос.. Опишите какой нибудь самый простой метод парсинга html кода...

Заранее благодарен

http://delphisite.ru/ishodniki/parser-html

---

А у меня такой вопросик:

Есть массив (примерно 40 строк), и я знаю что на 5 строке есть нужная мне информация, как мне из массива достать только 5 строчку?

Вся проблема в том что я не знаю что находится на 5 строчке... (Если бы знал то использовал Pos(), delete(), и т.д.

[iGlass]

http://delphisite.ru/ishodniki/parser-html


Спасибо =)

[W!z@rD]

Есть массив (примерно 40 строк), и я знаю что на 5 строке есть нужная мне информация, как мне из массива достать только 5 строчку?

Вся проблема в том что я не знаю что находится на 5 строчке... (Если бы знал то использовал Pos(), delete(), и т.д.

в массиве не строки, а элементы.
mas[index]
if (mas[index] != 'abc')
begin
exit;
end;

while(true)
begin
if (mas[index] == 'abc') break;
end;


по поводу парсинга html документа, самое простое это работа через DOM

[ErrorNeo]

с удовольствием приму любой простейший рабочий пример отправки http запроса через прокси на вин-апи.

без прокси оно выглядит примерно так:
wData:WSAData;
s:TSOCKET;
addr:sockaddr_in;

s:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
FillChar(addr, SizeOf(sockaddr_in), 0);
addr.sin_family:=AF_Inet;
addr.sin_port:=htons(80);
addr.sin_addr.S_addr:=inet_addr('218.123.123.123') ;
Connect(S,addr,SizeOf(TSockAddr));

sendbuff := 'GET http://site.ru/xmls/123.php HTTP/1.0'+ #13#10 +
'Host: pentagon.com'+ #13#10 +
'UserAgent: Mozilla/5.0 (Windows NT 5.1)'+ #13#10 +
'Accept: */*' + #13#10 +
'Referer: http://google.ru'+ #13#10 +
'Connection: Keep-Alive'+ #13#10#13#10;

send(s, sendbuff[1] , Length(sendbuff), 0);
recv(s,sBuff,5000,0);
Shutdown(S,SD_Send);
closesocket(s);

[slesh]

если http прокси то так и оставляй тока шли на IP и PORT прокси эти даныне

sendbuff := 'GET http://pentagon.com/xmls/123.php HTTP/1.0'+ #13#10 +
'Host: pentagon.com'+ #13#10 +
'UserAgent: Mozilla/5.0 (Windows NT 5.1)'+ #13#10 +
'Accept: */*' + #13#10 +
'Referer: http://google.ru'+ #13#10 +
'Proxy-Connection: Close'+ #13#10#13#10;

[НTL]

А как можно работать с антикапчой через сокеты? (Отправка файлов через кодировку multipart/form-data)

[$Atlet$]

На форме некого приложения есть несколько Memo, как выбрать конкретное из них средствами WinApi?

[slesh]

Выбрать? Всмысле? ЧТо ты хочеш сделать с ними?
Записать данные, считать данные, поставить фокус в вода или еще что?

[$Atlet$]

slesh, записать данные

[W!z@rD]

$Atlet$

FindWindow
FindWindowEx
SetWindowText

[$Atlet$]

А как с помощью FindWindowEx найти Memo? В нём ведь заголовков нет, а искать просто по классу они сверху вниз перебираются.

[НTL]

Возникла небольшая проблема с HTTP запросами/ответами через Wnisock,
При отправки запроса через HTTP Sender слеша, к примеру такова запроса:
GET /mchat/ HTTP/1.1
Content-Type: text/html
Host: testhtl.ucoz.ru
Accept: text/html, */*
Accept-Encoding: identity
User-Agent: Mozilla/3.0 (compatible; Indy Library)



Ответ придет с HTML кодом за 4 сек
А если убрать в коде эти строчки:
function send_packs(ip:string; port:word; send_buf:string; var recv_buf:string):integer;
var
SockAddrIn:TSockAddrIn;
tmp_buf:array[0..1024] of char;
len:longint;
socket_id:LongWord;
begin
result:=-10;
socket_id:=socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if socket_id=LongWord(-1) then exit;
SockAddrIn.sin_family := AF_INET;
SockAddrIn.sin_port := htons(port);
SockAddrIn.sin_addr.s_addr := inet_addr(Pansichar(GetIPAddress(ip)));
result:=-20;
if Connect(socket_id, SockAddrIn, SizeOf(SockAddrIn))<>0 then
begin
closesocket(socket_id);
exit;
end;
send(socket_id,send_buf[1],length(send_buf),0);
recv_buf:='';
repeat
len:=recv(socket_id,tmp_buf,1024,0);
recv_buf:=recv_buf+copy(tmp_buf,0,len);
until len<=0;
result:=length(recv_buf);
closesocket(socket_id);
end;

То ответ придет за 200 Ms, но без HTML кода...

Также если отправлять запросы через синфер, то ответ приходит за 1сек и с HTML кодом

Как можно отправить и получить ответ от сервера за минимальное время и с HTML кодом???

[slesh]

1) считываеш первый пакет. там будет HTTP заголовок который записал сервак.
Анализируеш поле Contend-Length
и если оно есть, то береш из него число переданных данныех. Затем считываеш их и разрываеш соединение. В противном случае
придется читать данные пока сервак не разорвет соединение сам.
А разорвет он быстро соединение тока тогда, когда будет в твоем заголовке чтото типа
Connection: Close

[UnknownZZZ]

Народ, в длл ктото розбирается ??

[slesh]

2 UnknownZZZ Я разбираюсь. Тебе достаточно будет такого ответа на вопрос?
По этому не задавай глупых вопрос, а сразу по теме пиши.

[UnknownZZZ]

я ещо на 433 странице написал свой вопрос, и никото ничего,.....

[Mykola-bas]

Всем привет, вот у меня вопрос :
как запретить ввоод всех символом кроме цыфр и знака "-" минус ? для всех едитов. спс

[slesh]

поставь для них один обработчик KeyPress и там пропиши код
if (Key in ['0'..'9', '-', #8] = false) then Key := #0;
#8 - это символ бакспейса (чтобы можно было стереть написанное)

[slesh]

2 UnknownZZZ я просто не понимаю твоей проблемы. Или опиши полностью где какая кнопка и что должно убраться или зающай функцию скрывания элементов и окон - ShowWindow(H, SW_HIDE) где H - дискриптор твоей кнопки

[intNet]

Лучше SetWindowLong(Edit2.Handle, GWL_STYLE, GetWindowLong(Edit2.Handle, GWL_STYLE) or ES_NUMBER);
Но тут только цифры.

[iGlass]

HELP :)

парсю эту строку в label

<tr><td>Пользователь</td><td align=center><b>iGlass</b></td></tr>

Дохожу до
iGlass</b></td></tr>

Начинаю удалять </b> И удаляется нужный текст... Что делать ?
Заранее оч. благодарен !

[intNet]

s:='<tr><td>Ïîëüçîâàòåëü</td><td align=center><b>iGlass</b></td></tr>';
delete(s, 1, pos('<b>', s)+2);
delete(s, pos('</b>', s), length(s));

[stanger]

Народ! Привет, есть проблемка, горит очень =) Возможно ли на обжект паскале сделать следующее: реализовать интерфейс с помощью классов, но так, чтобы класс был сделегирован (т.е. в теле интерфейса сделать ссылку на него) и самое главно, что, чтобы этот класс не объйявлять! Я вот не могу разобраться! Помогите! Вопщем в кратце, написать интерфейс методом делегирования без объявления класса.

[iGlass]

Через выше описаный метод не канает...


Код проги

var
S: TStringList;
P,I: integer;
user,balans,credit: string;
begin

S:=TStringList.Create; //Создаём Строковый листок
Memo1.Text:=idHttp1.Get('http://stat.elcity.ru/showstat.php?'+'uid='+login.Text+'&pwd='+password.Text); // Получаем страницу
S.Text:=Memo1.Text;
P:=S.IndexOf('<!--Вставка блока PHP -->');
//
if not (P=-1)
then
begin
for i:=0 to 3 do
begin
inc(P);
if Pos('Пользователь',S.Strings[p])>0
then user:=S.Strings[p];
if Pos('Текущий кредит',S.Strings[p])>0
then credit:=S.Strings[p];
if Pos('Баланс',S.Strings[p])>0
then balans:=S.Strings[p];

end;

end;
Delete(user,1,pos('<',user));
Delete(user,1,pos('td',user));
Delete(user,1,pos('>',user));
Delete(user,1,pos('b',user));
Delete(user,pos('/',user),20);
Delete(user,1,pos('<',user));
Delete(user,1,pos('td',user));
Delete(user,1,pos('>',user));
Delete(user,1,pos('b',user))
Delete(user,pos('/',user),20);
Label1.Caption:='Пользователь: '+user+#10#13+'Текущий кредит: '+credit+#10#13;

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

В чём проблема, помогайте плиз! От меня + В репу

Код странички


<!--Вставка блока PHP -->
<h2><font color=darkred size=+1 face=Arial>Общая информация</font></h2>
<table width=400 cellspacing=0 cellpadding=3 border=1>
<tr><td>Пользователь</td><td align=center><b>iglass</b></td></tr>

<tr><td>Ф.И.О.</td><td align=center><b>Иван</b></td></tr>
<tr><td>Лицевой счет</td><td align=center><b>10854</b></td></tr>
<tr><td>Тариф</td><td align=center><b>Безлимитный 560</b></td></tr>
<tr><td>Абонентская плата</td><td align=center><b>900 руб/месяц</b></td></tr>
<tr><td>Текущий кредит</td><td align=center><b>0 руб.</b></td></tr><tr><td>Сумма на счету</td><td align=center><b><font color=green>524.52</font> руб.</b></td></tr>

[Seregakz]

Народ подскажите как на дельфи узнать серийник харда (не серийник тома) чтобы на любой ОС пахало! спасиб

[Mykola-bas]

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

[W!z@rD]

иди русский учи

[Mykola-bas]

неучил неучу и учить небуду, если нет чего сказать по теме то лутше молчи.

[slesh]

2 Mykola-bas
ну в томже onkeypress обработчике делай чтото типа этого
if length(edit1.Text) = 1 then Edit2.SetFocus;

[Seregakz]

slesh вижу ты всезнающий =) не подскажеш как получить инфу о харде? (типа как Hardware_IDExtractor.dll)

[slesh]

это довольно геморно и под разные накопители по разному получается
можно читать SMART. МОжно через WMI. В инете вроде были исходники и того и другова.

Вот пример для IDE дисков под XP/2003
кода там очень мало. в осномном только описание структур.
У меня вывел - WD-WCAH81202167

function GetIdeDiskSerialNumber(disk:byte): string;
type
TSrbIoControl = packed record
HeaderLength: ULONG;
Signature: array[0..7] of Char;
Timeout: ULONG;
ControlCode: ULONG;
ReturnCode: ULONG;
Length: ULONG;
end;
SRB_IO_CONTROL = TSrbIoControl;
PSrbIoControl = ^TSrbIoControl;

TIDERegs = packed record
bFeaturesReg: Byte; // Used for specifying SMART "commands".
bSectorCountReg: Byte; // IDE sector count register
bSectorNumberReg: Byte; // IDE sector number register
bCylLowReg: Byte; // IDE low order cylinder value
bCylHighReg: Byte; // IDE high order cylinder value
bDriveHeadReg: Byte; // IDE drive/head register
bCommandReg: Byte; // Actual IDE command.
bReserved: Byte; // reserved for future use. Must be zero.
end;
IDEREGS = TIDERegs;
PIDERegs = ^TIDERegs;

TSendCmdInParams = packed record
cBufferSize: DWORD; // Buffer size in bytes
irDriveRegs: TIDERegs; // Structure with drive register values.
bDriveNumber: Byte; // Physical drive number to send command to (0,1,2,3).
bReserved: array[0..2] of Byte; // Reserved for future expansion.
dwReserved: array[0..3] of DWORD; // For future use.
bBuffer: array[0..0] of Byte; // Input buffer.
end;
SENDCMDINPARAMS = TSendCmdInParams;
PSendCmdInParams = ^TSendCmdInParams;

TIdSector = packed record
wGenConfig: Word;
wNumCyls: Word;
wReserved: Word;
wNumHeads: Word;
wBytesPerTrack: Word;
wBytesPerSector: Word;
wSectorsPerTrack: Word;
wVendorUnique: array[0..2] of Word;
sSerialNumber: array[0..19] of Char;
wBufferType: Word;
wBufferSize: Word;
wECCSize: Word;
sFirmwareRev: array[0..7] of Char;
sModelNumber: array[0..39] of Char;
wMoreVendorUnique: Word;
wDoubleWordIO: Word;
wCapabilities: Word;
wReserved1: Word;
wPIOTiming: Word;
wDMATiming: Word;
wBS: Word;
wNumCurrentCyls: Word;
wNumCurrentHeads: Word;
wNumCurrentSectorsPerTrack: Word;
ulCurrentSectorCapacity: ULONG;
wMultSectorStuff: Word;
ulTotalAddressableSectors: ULONG;
wSingleWordDMA: Word;
wMultiWordDMA: Word;
bReserved: array[0..127] of Byte;
end;
PIdSector = ^TIdSector;

const
IDE_ID_FUNCTION = $EC;
IDENTIFY_BUFFER_SIZE = 512;
DFP_RECEIVE_DRIVE_DATA = $0007C088;
IOCTL_SCSI_MINIPORT = $0004D008;
IOCTL_SCSI_MINIPORT_IDENTIFY = $001B0501;
DataSize = sizeof(TSendCmdInParams) - 1 + IDENTIFY_BUFFER_SIZE;
BufferSize = SizeOf(SRB_IO_CONTROL) + DataSize;
W9xBufferSize = IDENTIFY_BUFFER_SIZE + 16;
var
hDevice: THandle;
cbBytesReturned: DWORD;
pInData: PSendCmdInParams;
pOutData: Pointer; // PSendCmdInParams;
Buffer: array[0..BufferSize - 1] of Byte;
srbControl: TSrbIoControl absolute Buffer;

procedure ChangeByteOrder(var Data; Size: Integer);
var
ptr: PChar;
i: Integer;
c: Char;
begin
ptr := @Data;
for i := 0 to (Size shr 1) - 1 do
begin
c := ptr^;
ptr^ := (ptr + 1)^;
(ptr + 1)^ := c;
Inc(ptr, 2);
end;
end;

begin
Result := '';
FillChar(Buffer, BufferSize, #0);
hDevice := CreateFile(pchar('\\.\Scsi'+inttostr(disk)+':'), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
if hDevice = INVALID_HANDLE_VALUE then Exit;
try
srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL);
System.Move('SCSIDISK', srbControl.Signature, 8);
srbControl.Timeout := 2;
srbControl.Length := DataSize;
srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY;
pInData := PSendCmdInParams(PChar(@Buffer) + SizeOf(SRB_IO_CONTROL));
pOutData := pInData;
with pInData^ do
begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
bDriveNumber := 0;
with irDriveRegs do
begin
bFeaturesReg := 0;
bSectorCountReg := 1;
bSectorNumberReg := 1;
bCylLowReg := 0;
bCylHighReg := 0;
bDriveHeadReg := $A0;
bCommandReg := IDE_ID_FUNCTION;
end;
end;

if not DeviceIoControl(hDevice, IOCTL_SCSI_MINIPORT, @Buffer, BufferSize, @Buffer, BufferSize, cbBytesReturned, nil) then Exit;
finally
CloseHandle(hDevice);
end;

with PIdSector(PChar(pOutData) + 16)^ do
begin
ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));
SetString(Result, sSerialNumber, SizeOf(sSerialNumber));
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
s: string;
begin
s := GetIdeDiskSerialNumber(0);
if s <> '' then ShowMessage(s);
end;

[slesh]

но вообще советую полистать вот эти сайты:
http://www.delphimaster.ru/cgi-bin/forum.pl?id=1233313403&n=5
http://msdn.microsoft.com/en-us/library/aa394132(VS.85).aspx
http://www.magsys.co.uk/delphi/magwmi.asp

Да и что тебе не дает юзать HardwareIDExtractor.dll

Но лучше копать в сторону WMI потому что это более надежнее

[Seregakz]

slesh (выше пример прога вообще молчит хотя у друга показало серийник) я бы юзал HardwareIDExtractor.dll )) так она платная эта либа(((((

[slesh]

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

var
serial:dword;
tmp:dword;
begin
if GetVolumeInformation('c:\', 0, 0, @serial, tmp, tmp, 0, 0) then
showmessage(inttohex(serial, 8));

[Seregakz]

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

var
serial:dword;
tmp:dword;
begin
if GetVolumeInformation('c:\', 0, 0, @serial, tmp, tmp, 0, 0) then
showmessage(inttohex(serial, 8));


не тома) я скрины попутал =)

[slesh]

ну тогда только WMI юзай

[slesh]

Вот тут навоял небольшую функцию для получения серийника первого винта юзая WMI
Код слегка через жопный, но работает.



uses ComObj, ActiveX;

function CoInitialize(pvReserved: Pointer): HResult; stdcall; external 'ole32.dll' name 'CoInitialize';

function GetHDDSerialNum():string;
var
locator:variant;
service:variant;
properties:variant;
p:IUnknown;
p1:Olevariant;
Enum:IEnumVariant;
Value: Cardinal;
begin
CoInitialize(nil);
locator := CreateOleObject('WbemScripting.SWbemLocator');
service := locator.ConnectServer('.');
properties := service.ExecQuery('SELECT * FROM Win32_PhysicalMedia');

p := properties._NewEnum;
p.QueryInterface(IEnumVariant, Enum);
Enum.Next(1, p1, Value);
result := p1.SerialNumber;
locator := Unassigned;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetHDDSerialNum());
end;

[Mykola-bas]

slesh спс)

[Seregakz]

slesh спс но на вин7 не паше =)

[slesh]

ну это же W7. Там чтобы получить такую инфу необходимо запустить прогу от имени админа. (в контекстном меню кликаеш - запустить от имени администратора)
А вообще этот код в основном для XP и 2k3
В Win 2k и ниже пахать скорее всего не будет.

[Flenov]

Господа, кто может помочь.
Есть EXE-шник (чужой), допустим он не упакован, мне нужно залезть в его ресурсы и заменить там определённые файлы
(допустим тупо сменить набор иконок).
Дайте либо надёжную прогу, которой сами пользовались,
Либо код Delphi,
Либо ссылку на тему, где об этом описывалось.

[alexey-m]

Господа, кто может помочь.
Есть EXE-шник (чужой), допустим он не упакован, мне нужно залезть в его ресурсы и заменить там определённые файлы
(допустим тупо сменить набор иконок).
Дайте либо надёжную прогу, которой сами пользовались,
Либо код Delphi,
Либо ссылку на тему, где об этом описывалось.
Вот посмотри тут и выбирай какой тебе по душе:
http://www.cracklab.ru/download.php?action=list&n=MzU=

[alexey-m]

Подскажите пожалуйста, как правильно преобразовать PWideChar в String

[inspektor]

Подскажите пожалуйста, как правильно преобразовать PWideChar в String
мне тож интересно!!!! :)

[slesh]

WideCharToString

[alexey-m]

WideCharToString
Не получается =( возвращает либо ошибку либо мусор...если можно небольшой пример...может чего не так делаю)

[slesh]

скорее всего чтото не так делаеш. А также ты уверен что там именно widechar а не utf8

вот пример простой

var
s:string;
pw:PWideChar;
n:dword;
begin
n := 1024;
getmem(pw, n); // выделим память под переменную
GetUserNameW(pw, n); // получим имя юзверя в виде WideChar
s := WideCharToString(pw); // Преобразуем в нормальный вид
freemem(pw); // освободим память
ShowMessage(s); // выведем на экран в нормальном виде
end;

[Logan22]

Подскажите пожалуйста...Я навичок
Через Button каким скриптом открывать .bat файлы?
типо по этому адрессу БАТ лежит "H:\010101.bat"

[ZirroCool]

Logan22,если ты имеешь в виду запустить, то юзай функцию shellexecute или winexec!

[stalcer]

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

[Logan22]

Logan22,если ты имеешь в виду запустить, то юзай функцию shellexecute или winexec!
В uses добавил ShellAPI
на кнопку ввел скрипт этот

begin
ShellExecute(Handle, 'open',
'H:\La2offline Interlude v1.9\la2offline.vo.uz\123\startGameServer.bat', '', nil,
SW_SHOWNORMAL);
end;

Но когда нажимаю на кнопку в ехе"шнике появляется ошибки!
Вот ошибка! _http://www.imagebam.com/image/32666949009139

Но когда вручную врубаю без проги то всё норм, загрузка идет без этих ошибок!

[wolmer]

В uses добавил ShellAPI
на кнопку ввел скрипт этот

begin
ShellExecute(Handle, 'open',
'H:\La2offline Interlude v1.9\la2offline.vo.uz\123\startGameServer.bat', '', nil,
SW_SHOWNORMAL);
end;

Но когда нажимаю на кнопку в ехе"шнике появляется ошибки!
Вот ошибка! _http://www.imagebam.com/image/32666949009139

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

[Logan22]

"Пробывал через winexec? Если нет то попробуй, должно сработать"

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

[Logan22]

Если это это)

begin
WinExec('H:\La2offline Interlude v1.9\la2offline.vo.uz\123\startgameserver.bat', SW_SHOW);
end;

То не канает(((

[W!z@rD]

блииаааа...

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

Кидаю сюда содержимое батника.
P.S. JRE стоит-то?

[Logan22]

@echo off
title Game Server Console
:start
echo Starting L2J Game Server.
echo.
REM -------------------------------------
REM Default parameters for a basic server.
start /b /abovenormal ../jre/bin/java -Xmx512m -cp bsf.jar;bsh-2.0b4.jar;commons-logging-1.1.jar;mmocore.jar;javolution.jar;c3p0-0.9.1.2.jar;mysql-connector-java-5.0.7-bin.jar;l2jserver.jar;jython.jar net.sf.l2j.gameserver.GameServer
REM
REM If you have a big server and lots of memory, you could experiment for example with
REM java -server -Xmx1536m -Xms1024m -Xmn512m -XX:PermSize=256m -XX:SurvivorRatio=8 -Xnoclassgc -XX:+AggressiveOpts
REM -------------------------------------
if ERRORLEVEL 2 goto restart
if ERRORLEVEL 1 goto error
goto end
:restart
echo.
echo Admin Restart ...
echo.
goto start
:error
echo.
echo Server terminated abnormaly
echo.
:end
echo.
echo server terminated
echo.
pause


Изначально этот батник другая прога включает без проблем... но я хочу дополнить!
Та программа создана с помощью этого))) "AutoPlay Media Studio 7.0")))
Так что содержимое батника роли не играет))) в принципе!
Батник подает запросы в ява ядро

[slesh]

Как всегда люди не обращают внимание на пути файла с пробелами ((( и по этому не юзают ковычки.

winexec('"d:\папка с пробелом\file.bat"', SW_SHOW);
Опостроф + ковычка + путь + ковычка + опостроф

[Logan22]

begin
winexec('"H:\La2offline Interlude v1.9\la2offline.vo.uz\123\startGameServer.bat"', SW_SHOW);
end;

Также ошибка!!! ((( что я показывал выше со скрином

[W!z@rD]

мдооо...

start /b /abovenormal ../jre/bin/java -Xmx512m -cp bsf.jar;bsh-2.0b4.jar;commons-logging-1.1.jar;mmocore.jar;javolution.jar;c3p0-0.9.1.2.jar;mysql-connector-java-5.0.7-bin.jar;l2jserver.jar;jython.jar net.sf.l2j.gameserver.GameServer

как ты думаешь, где он ищет ../jre/bin/java?
перед этим cd "директория"
тем самым установив активную директорию.

[Logan22]

ну а что можешь посоветовать?!

[iGlass]

Народ, а вот я опять по поводу парсинга =))

<tr><td>Абонентская плата</td><td align=center><b>900 руб/месяц</b></td></tr>

Вот строчка допустим как из неё удалить все тэги.. и вывести в label

Функция POS отдыхает...

var
sl:TStringList;
s,user,balans,credit:String;

begin
sl.create;
sl.text:=idhttp.get(тут адрес откуда я беру строчку);
sl.indexOf('LineHere);
А вот что дальше ? )))

Заранее благодарен!

[slesh]

хм. тупанул. нужно было сразу на скрин глянуть. В проге всё нормально это глюк в батнике
В начале батника попробуй прописать команду
CD "H:\La2offline Interlude v1.9\la2offline.vo.uz\123\"

[slesh]

2 iGlass самый быстры способ, но небудет пахать на кривой реализации или на очень сложной системе где есть хитрые JS но и то можно сделать проверку на это а так алгоритм такой примерно:

var
x,y:integer;
s1,s2:string;
tagflag:boolean;
begin
s1 := '<b>big</b> <a href="http://site.com/">link</a>';
s2 := '';
y := length(s1);
tagflag := false;

for x:=1 to y do
begin
if s1[x] = '<' then
begin
tagflag := true
end
else if s1[x] = '>' then
begin
tagflag := false
end
else if tagflag = false then s2:=s2+s1[x];
end;

showmessage(s2);

end;


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

[iGlass]

Что то он целиком всю строчку грузит не убирая тэгов (
Спс за помощь.

[transserg]

как можно подавить реакцию компа на ВСЕ!!! клавиши клавиатуры? так как BlockInput непомогает отрубается после вызова деспетчера задач, да и еще не блочит мультимедийные клавиши что ни есть гуд.

[Dosia]

// отрубаем мышь и клаву

procedure LockPC;
var
OldValue: LongBool;
begin
SystemParametersInfo(97, Word(Bool), @OldValue, 0);
WinExec(PChar('rundll32 mouse,disable'), SW_SHOW);
WinExec(PChar('rundll32 keyboard,disable'), SW_SHOW);
end;

// блокируем пк

procedure TForm1.Button1Click(Sender: TObject);
begin
LockWorkStation;
end;

{ Loading LockWorkStation dynamically}

function LockWS: Boolean;
// by Thomas Stutz, SDC
type
TLockWorkStation = function: Boolean;
var
hUser32: HMODULE;
LockWorkStation: TLockWorkStation;
begin
// Here we import the function from USER32.DLL
hUser32 := GetModuleHandle('USER32.DLL');
if hUser32 <> 0 then
begin
@LockWorkStation := GetProcAddress(hUser32, 'LockWorkStation');
if @LockWorkStation <> nil then
begin
LockWorkStation;
Result := True;
end;
end;
end;

взято отсюда (http://www.swissdelphicenter.ch/torry/showcode.php?id=853)

[yfet]

вопрос такой. есть список акков вк. как правильно пройти аторизацию на сайте и узнать валид акк или нет? пользую idHTTP.
пишу так
[.code]
var
sl : TStringList;
begin
sl:=TStringList.Create;
sl.Add('email='+email);
sl.Add('pass='+pass);
IdHTTP1.Post('http://login.vk.com/?act=login',sl);
sl.Free;
end;
[/.code]
но че то хреново оно заходит, не вижу этот id в онлайне((
Помогите плз

[wolmer]

вопрос такой. есть список акков вк. как правильно пройти аторизацию на сайте и узнать валид акк или нет? пользую idHTTP.
пишу так
[.code]
var
sl : TStringList;
begin
sl:=TStringList.Create;
sl.Add('email='+email);
sl.Add('pass='+pass);
IdHTTP1.Post('http://login.vk.com/?act=login',sl);
sl.Free;
end;
[/.code]
но че то хреново оно заходит, не вижу этот id в онлайне((
Помогите плз

HTML:
<form method="post" name="login" id="login" action="http://login.vk.com/" onsubmit="if (vklogin) { return true} else { quick_login();return false;}">
<input type="hidden" name="act" id="act" value="login">
<input type="hidden" name="success_url" id="success_url" value="">
<input type="hidden" name="fail_url" id="fail_url" value="">
<input type="hidden" name="try_to_login" id="try_to_login" value="1">
<input type="hidden" name="to" id="to" value=""/>
<input type="hidden" name="vk" id="vk" value="">

<table align="center" cellpadding=0 cellspacing=7 border=0 width="40%">
<tr>
<td width="100px">
<span class="grey">Email:</span>
</td>
<td>
<input class="inputText" type="text" name="email" value="" id="email" size="25" />
<td>
</tr>
<tr>
<td>
<span class="grey">Пароль:</span>
</td>
<td>
<input class="inputText" type="password" name="pass" value="" id="pass" size="25" />
</td>
</tr>
<tr>
<td>
&nbsp;
</td>
<td>
<input style="margin-top:1px; vertical-align: middle;" type="checkbox" name="expire" id="expire" value="1" /><small>Чужой компьютер</small>
</td>
</tr>
<tr>
<td>
&nbsp;
</td>
<td>
<div style="height:20px; margin:5px 0px">
<ul class='nNav'><li style="margin-left:0px">
<b class="nc"><b class="nc1"><b></b></b><b class="nc2"><b></b></b></b>
<span class="ncc"><a href="javascript: quick_login()">Вход</a></span>
<b class="nc"><b class="nc2"><b></b></b><b class="nc1"><b></b></b></b>
</li>
<li>
<b class="nc"><b class="nc1"><b></b></b><b class="nc2"><b></b></b></b>
<span class="ncc"><a href="/reg0">Регистрация</a></span>
<b class="nc"><b class="nc2"><b></b></b><b class="nc1"><b></b></b></b>
</li></ul>
</div>

</td>
</tr>
<tr>
<td>
&nbsp;
</td>
<td class="forgotPass">
<a href="login.php?op=forgot">Забыли пароль?</a>
</td>
</tr>

</table>
<input type="submit" value='.' style="color:#fff;border:0;padding:0;margin:0;background: #fff;height:6px;width:6px"/>
</form>

Видишь инпаты? (input) Вот их и пихай (name и value ихнии) в пост запрос а не токо email и password (так просто не пройдет!)

Не разобрал что я сказал? Ок, бери сниффер http пакетов, снифай что отправляется на сервер при логине/входе

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

...
sl.Add('act=login');
sl.Add('success_url=');
sl.Add('fail_url=');
sl.Add('try_to_login=1');
sl.Add('to=');
sl.Add('vk=');
sl.Add('expire=1');
sl.Add('email='+email);
sl.Add('pass='+pass);
...

Кстати на сайте может включатся каптча если что...

[vvs777]

тупой вопрос, особенно для меня, но не могу найти исходник, в котором эту проблему пару лет назад решил и не помню как.
Вообщем надо строку преобразовать в юникод. Желательно не ипаццо с типами переменных, а так чтобы это в string хранилось, просто вместо кириллических символов стояло 2 с соответствующими кодами.

Есть у кого функция готовая?

[slesh]

юзай StringToWideChar - чтобы все символы были в расширенном виде.
Или если тебе нужне не юников, а UTF8 что скорее всего. То AnsiToUtf8

[transserg]

2 Dosia нужно просто заблокировать клаву а не выходить из сеанса пользователя
вот это не работает=)

procedure LockPC;
var
OldValue: LongBool;
begin
SystemParametersInfo(97, Word(Bool), @OldValue, 0);
WinExec(PChar('rundll32 mouse,disable'), SW_SHOW);
WinExec(PChar('rundll32 keyboard,disable'), SW_SHOW);
end;

[slesh]

эти команды тока под Win 9x
Под другие винды юзай апишку BlockInput на XP точно пашет.


procedure BlockInput(ABlockInput: boolean); stdcall; external 'USER32.DLL';

procedure TForm1.Button1Click(Sender: TObject);
begin
BlockInput(True); - заблокировать клаву и мыш
sleep(5000);
BlockInput(false); - разблокировать
end;

[transserg]

2slesh как я уже говорил что BlockInput работает до первого нажатия на Cntrl+Alt+Del к тому же он не блокирует функциональные клавиши типа яркость громкость вперед назад и.т.д

[_nic]

Как организовать drag n drop файлов из єксплорера в ListBox ?

[Logan22]

Помогите пожалуйста правельно вставить Edit

Я тут допустил ошибку!
SetCursorPos('+edit1.text+', '+edit2.text+');
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
Sleep(200);
end;
При компиляции такая ошибка!

[Error] Unit1.pas(31): Incompatible types: 'Integer' and 'String'
[Error] Unit1.pas(31): Incompatible types: 'Integer' and 'String'
[Fatal Error] Project1.dpr(5): Could not compile used unit 'Unit1.pas'

[slesh]

ты сам хоть понял что ты написал в коде? Сначало учи основы синтаксиса а потом начинай кодить.

SetCursorPos(strtoint(edit1.text), strtoint(edit2.text));

[Nullsleep]

_nic

uses ShellAPI;
...

public
procedure DropFiles(var msg: TWMDropFiles); message WM_DROPFILES;
...

procedure TForm1.DropFiles(var msg: TWMDropFiles);
var
drop, count: THandle;
i: Integer;
buf: array[0..MAX_PATH-1] of Char;
begin
drop := msg.Drop;
//получаем количество перетаскиваемых объектов
count := DragQueryFile(drop, $ffffffff, nil, 0);
for i := 0 to count-1 do
begin
//получаем имя i-того файла
DragQueryFile(drop, i, buf, MAX_PATH);
//добавляем в листбокс только файлы (отсееваем папки)
if FileExists(buf) then ListBox1.Items.Add(buf);
end;
DragFinish(drop);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles(Handle, True);
end;

[Mykola-bas]

снова я)
Вопросик:
Вообшем у меня програма отправляет запрос на авторизацию на сервер... вопрос в том как обработать ответ? тоесть как узнать что авторизацыя удалась или нет? думал проанализировать хтлм код на присутствие ссылки типа /profile.php=id и т.д. но может есть попроще способ? если да по пожалуйста напишыте код

(реч идет о вк)

[gisTy]

снова я)
Вопросик:
Вообшем у меня програма отправляет запрос на авторизацию на сервер... вопрос в том как обработать ответ? тоесть как узнать что авторизацыя удалась или нет? думал проанализировать хтлм код на присутствие ссылки типа /profile.php=id и т.д. но может есть попроще способ? если да по пожалуйста напишыте код

(реч идет о вк)
ты бы язык русский выучил сначала.

[Seregakz]

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

function DownloadFile(const Url: string): string;
var
NetHandle: HINTERNET;
UrlHandle: HINTERNET;
Buffer: array[0..1024] of char;
BytesRead: cardinal;
begin
Result := '';
NetHandle := InternetOpen('Delphi 5.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;

[ange007]

снова я)
Вопросик:
Вообшем у меня програма отправляет запрос на авторизацию на сервер... вопрос в том как обработать ответ? тоесть как узнать что авторизацыя удалась или нет? думал проанализировать хтлм код на присутствие ссылки типа /profile.php=id и т.д. но может есть попроще способ? если да по пожалуйста напишыте код

(реч идет о вк)
1) Учи язык
2)Пользуй Post запросы при авторизации, в ответах от них есть информация,-авторизировался или нет.

[Mykola-bas]

1) Учи язык
2)Пользуй Post запросы при авторизации, в ответах от них есть информация,-авторизировался или нет.
Можна пример кода?

[herfleisch]

Люди, которые пишут на Delphi, а где вы берёте среду разработки? Существуют вообще бесплатные IDE ???

[wolmer]

Вопрос по компоненту TreeView... Как при нажатии на кнопку сделать так чтобы выводились в memo элементы (каталоги) определенного дерева

Такой вариант не идет:

var
i : Integer;
begin
for i:=1 to TreeView1.Items[0].Count do
Memo1.Lines.Add(TreeView1.Items[i].Text);
Такой вариант кода (как выше) мне не подходит, так как выводится и элементы дерев (именно содержание дерев) указанного дерева из которого извлекаем

[Nullsleep]

const
level = 0;
var
i : Integer;
begin
for i := 0 to TreeView1.Items.Count-1 do
if TreeView1.Items[i].Level = level then
Memo1.Lines.Add(TreeView1.Items[i].Text);
end;

Константа level - это уровень вложенности деревьев.

[wolmer]

const
level = 0;
var
i : Integer;
begin
for i := 0 to TreeView1.Items.Count-1 do
if TreeView1.Items[i].Level = level then
Memo1.Lines.Add(TreeView1.Items[i].Text);
end;

Константа level - это уровень вложенности деревьев.
Не то, выводятся элементы определенного уровня деревьев а не определенного дерева

[Nullsleep]

const
n = 1;
var
i : Integer;
begin
for i := 0 to TreeView1.Items[n].Count-1 do
Memo1.Lines.Add(TreeView1.Items[n].Item[i].Text);
end;

n - номер дерева

[Sin3v]

Delphi
Как строку в hex перевести ?

[ex3me]

Sin3v, так?


function StrToHex(AStr: string): string;
var
I: Integer;
Tmp: string;
begin
Result := '';
For I := 1 to Length(AStr) do
begin
Result := Result + Format('%2x', [Byte(AStr[I])]);
end;
I := Pos(' ', Result);
While I <> 0 do
begin
Result[I] := '0';
I := Pos(' ', Result);
end;
end;

function TransChar(AChar: Char): Integer;
begin
if AChar in ['0'..'9'] then
Result := Ord(AChar) - Ord('0')
else
Result := 10 + Ord(AChar) - Ord('A');
end;


function HexToStr(AStr: string): string;
var
I: Integer;
CharValue: Word;
begin
Result := '';
For I := 1 to Trunc(Length(Astr)/2) do
begin
Result := Result + ' ';
CharValue := TransChar(AStr[2*I-1])*16 + TransChar(AStr[2*I]);
Result[I] := Char(CharValue);
end;
end;

[#berkut#]

function StringtoHex(Data: string): string;
var
i, i2: Integer;
s: string;
begin
i2 := 1;
for i := 1 to Length(Data) do
begin
Inc(i2);
if i2 = 2 then
begin
s := s + ' ';
i2 := 1;
end;
s := s + IntToHex(Ord(Data[i]), 2);
end;
Result := s;
end;

[Kuzya]

Здравствуйте. Нужно узнать количество вхождений подстроки в строку. Есть ли для этого в Delphi специальная отдельная функция?
И ещё. Есть ли в Delphi встроеная функция на подобие explode() или split()?

UPDATE: Функция типа split найдена - ExtractStrings

[alexey-m]

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

[Nullsleep]

Здравствуйте. Нужно узнать количество вхождений подстроки в строку. Есть ли для этого в Delphi специальная отдельная функция?
И ещё. Есть ли в Delphi встроеная функция на подобие explode() или split()?

UPDATE: Функция типа split найдена - ExtractStrings

function PosCount(const Substr, Str: string): Integer;
var
i, p: Integer;
s: string;
begin
s := Str;
Result := 0;
for i := 1 to Length(s) do
begin
p := Pos(Substr, s);
if p <> 0 then Inc(Result);
Delete(s, 1, p);
end;
end;

[slesh]

2 Nullsleep твой код конечно очень наглядный, но увы очень медленный ((
Работа со строками в делфи - это очень медленная вешь. Вот банальный пример.

Твоя функция(PosCount) - основанная на работе со строка и
моя(mPosCount) основанная на работе с память. ПРи больших размерах строки скорость реально заметна.

function PosCount(const Substr, Str: string): Integer;
var
i, p: Integer;
s: string;
begin
s := Str;
Result := 0;
for i := 1 to Length(s) do
begin
p := Pos(Substr, s);
if p <> 0 then Inc(Result);
Delete(s, 1, p);
end;
end;

function mPosCount(const Substr, Str: string): Integer;
var
s: pchar;
len: integer;
sublen: integer;
begin
s := @str[1];
sublen := length(substr);
len := length(str) - sublen + 1;
result := 0;
while len > 0 do
begin
if CompareMem(s, @substr[1], sublen) then
begin
inc(result);
len := len - sublen;
s := s + sublen;
end
else
begin
dec(len);
inc(s);
end;
end;
end;



И вот тестирование работы:

procedure TForm1.Button1Click(Sender: TObject);
var
x:integer;
s1,s2:string;
start, stop:dword;
cnt:integer;
begin
s1 := 'dfgdfklgjkfdg8fdg8f0dg09g0f9d0g';
s2 := '';
for x:=1 to 20000 do s2:=s2+s1;
start := GetTickCount;
cnt := mPosCount(s1, s2);
stop := GetTickCount;
memo1.Lines.Add(inttostr(stop - start));
memo1.Lines.Add('CNT: '+inttostr(cnt));

start := GetTickCount;
cnt := PosCount(s1, s2);
stop := GetTickCount;
memo1.Lines.Add(inttostr(stop - start));
memo1.Lines.Add('CNT: '+inttostr(cnt));
end;


Результаты видны сразу
0
CNT: 20000
1578
CNT: 20000
т.е. мой код данные действия сделал меньше чем за 1 микросекунду.
А твой код делал 1578 микросекунд что примерно равно 1,5 секунды
При кол-во повторов 100k мой код выполнил данные действия также меньше микросекунды (иногда 16 микросекунд при загруженности проца) а сколько делает это твой код - я хз. потому что надоело ждать.

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

[slesh]

Интересная зависимость при тестировании скорости работы со строками.

CNT: 5000 - 94
CNT: 10000 - 406
CNT: 20000 - 1578
CNT: 40000 - 6297

т.е. видно что увеличении длинный строки в 2 раза уменьшает скорость в 4 раза.

CNT: 80000 - 35609 - хотя я хз почему тут не в 4 раза больше предыдущего а в 5,7 раз.


Вот так вот и доверяй делфи и её скорости. Если работать с память то скорость выходит:
CNT: 10 000 000 - 407
как видно что за 407 микросекунд тут обработалось 10 миллионов повторов, в на строках тока 10 тысяч.
Вот и выходит что разница по скорости - в 1000 раз.

[toxa001]

Подскажите как можно получить код изображения под делфи ?

Вот короткий пример формы куда будет вставлятся изображение:
object Form1: TForm1
Left = 0
Top = 0
BorderStyle = bsNone
ClientHeight = 413
ClientWidth = 549
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
PixelsPerInch = 96
TextHeight = 13
object Image1: TImage
Left = 0
Top = 0
Width = 549
Height = 413
Align = alClient
Picture.Data = {код изображения}
ExplicitWidth = 553
ExplicitHeight = 378
end
end

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

[slesh]

так в image есть свойство Picture и там выбирается картинка.
А тут(в исходнике формы) таже самая картинка только переведенная в hex
можеш взять WinHex и перевести сам. Вот тока там скорее всего не сама может быть картнка а уже готовый битмап

[toxa001]

Картинка в исходнике примерно в таком виде была :
0A544A504547496D616765B4090100FFD8FFE000104A464946 00010101006000
600000FFDB0043000503040404030504040405050506070C08 070707070F0B0B

скопировал пару строчек ...

попробовал рисунок в hex перевести ... и форма что то не компилится ... видимо что то не так.

[toxa001]

PS: строчки в сорце слитно написаны ... форум их разбил на 2 столбца

[alexey-m]

toxa001, я правильно тебя понял тебе надо сохранить рисунок с формы или что? Если так, то это проще сделать открыв в эту форму в delphi, и где загружается картинка есть кнопочка 'сохранить', насколько я помню)

[toxa001]

мне надо сменить рисунок ... сейчас открыл форму в делфи ... но чего то не пойму как рисунок вставить =)

[alexey-m]

мне надо сменить рисунок ... сейчас открыл форму в делфи ... но чего то не пойму как рисунок вставить =)
В контроле TImage есть свойство Picture кликни в этом поле 2 раза появится окно загрузки картинки далее думаю понятно все)

[toxa001]

Всем спасибо =)

[miqo]

Как можно редактировать элемент TListBox при двойном шелчке

[alexey-m]

Есть такой код на С++:

for (r = 0; r < ClCount; r++, FileSize -= BlockSize)
{
Offset.QuadPart = ClusterSize * Clusters[r];
SetFilePointer(hDrive, Offset.LowPart, &Offset.HighPart, FILE_BEGIN);
ReadFile(hDrive, Buff, ClusterSize, &Bytes, NULL);
BlockSize = FileSize < ClusterSize ? FileSize : ClusterSize;
WriteFile(hFile, Buff, BlockSize, &Bytes, NULL);
}

Как перевести его на Delphi, точнее не сам цикл, а всего лишь вот эту строчку:

BlockSize = FileSize < ClusterSize ? FileSize : ClusterSize;

подскажите =)

[razb]

Как перевести его на Delphi, точнее не сам цикл, а всего лишь вот эту строчку:
if FileSize < ClusterSize then BlockSize := FileSize
else BlockSize := ClusterSize;

[alexey-m]

if FileSize < ClusterSize then BlockSize := FileSize
else BlockSize := ClusterSize;
Пасиб) razb, я в принципе так и думал, но лучше уточнить, чем гадать так или не так)!

[miqo]

Как в ListBox-е вставить строку после определенной строки ?

[Nullsleep]

ListBox1.Items.Insert(5, 'stroka')
5 - индекс строки

[miqo]

Memo1.Lines.Insert(5, 'stroka');
5 - индекс строки

спасибо!

[alexey-m]

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

[Nullsleep]

alexey-m, попробуй этот код, но я не уверен, что поможет (это почти тоже самое, что и у тебя)

var
whole: file;
buf: array[1..8192] of Byte;
begin
AssignFile(whole, whole_name);
FileMode := 0; //только чтение
Reset(whole, 1);
BlockRead(whole, buf, 8192);
CloseFile(whole);
end;

[alexey-m]

...монопольно другим приложением?каким?
Да любым приложением), надо прочитать\ скопировать файл не убивая этот процесс

[Fepsis]

Здравствуйте, господа.. НЕбольшой вопрос.. Пытаюсь авторизоваться на mail.ru так:
var
tst : TStringList;
ex: string;
begin
tst := TStringList.Create;
tst.Add('Login=логин');
tst.Add('Domain=домен');
tst.Add('Password=пароль');
ex := Form1.IdHTTP1.post('http://win.mail.ru/cgi-bin/auth',tst);
end;
Так вот какое дело, если логин с паролем валидные выдаёт ошибку
HTTP/1.1 302 OK
Если не валид - то в ex страница авторизации (что логично)

Как решить эту проблему через indy (другие варианты пока не рассматриваются)..?!
Да, и если я прямо откровенно туплю, не судите строго... Только начал с Делфи разбираться.. :rolleyes:


ПС: В пхп смотрел, сразу после запроса выдаёт что-то вроде:
<HTML>http://win.mail.ru/cgi-bin/checkcookie?id=02727a43776c7a54190502190a1d00041c0 5020b4966535c465d050306020816020304165a4a544054454 61658505d5b174345</HTML>

[Mykola-bas]

хочу зделать чекер аков.
Вообшем ситема такая авторизация, смотрим код страницы, через рег.выражение ищем ссылку, и если она <> 1 или 0, то пишем мыло;пасс в файл и дальше....
так вот:

procedure TForm1.Button2Click(Sender: TObject);
var Count: Integer;
RegExp: TRegExpr;
Str1, Str2,ss,s: String;
P, i,j,z:integer;
HTMLDocument: IHTMLDocument2;
PersistFile: IPersistFile;
begin Z:=StrToInt(edit3.Text);
i:=0;
While i<= Memo1.Lines.Count do
begin if I<=Memo1.Lines.Count then
begin RegExp := TRegExpr.Create;
RegExp.Expression := '[_a-zA-Z\d\-\.]+@([_a-zA-Z\d\-]+(\.[_a-zA-Z\d\-]+)+)';
if RegExp.Exec(Memo1.lines[i]) then
begin
edit1.Text:= RegExp.Match[0];
RegExp.Expression := ':([^\s]+)';
if RegExp.Exec(Memo1.lines[i]) then
begin
ss:=RegExp.Match[0];
Delete(ss, 1, 1);
end;
edit2.Text:=ss;
s:='http://vkontakte.ru/login.php?email='+edit1.text+'&pass='+edit2.text+'&HTTP/1.0';
WebBrowser1.Navigate(s);
Sleep(Z);
HTMLDocument := WebBrowser1.Document as IHTMLDocument2;
Memo3.Text :=(HTMLDocument.all.Item(1, 0) as IHTMLElement).OuterHTML;
end;
I:=i+1;
end;
end;
end;

авторизовуюсь, а код страницы немогу открыть.
если
HTMLDocument := WebBrowser1.Document as IHTMLDocument2;
Memo3.Text := (HTMLDocument.all.Item(1, 0) as IHTMLElement).OuterHTML;


зделать в отдельную процедуру то робит.
что я зделал не так?

[Nightmarе]

Есть директория C:\lol\
В ней лежит всего один .exe файл с неизвестным именем.
Как мне его можно запустить не зная названия? приведите пример плз, а не теорию.

[Nullsleep]

var
SR: TSearchRec;
FindResult: Integer;
s: string;
begin
FindResult := FindFirst('C:\lol\*.exe', faAnyFile, SR);
if FindResult = 0 then
begin
s := SR.Name;
WinExec(PChar(s), SW_SHOW);
end;
end;

[miqo]

Как можно обьявит переменную которую могут исползовать все формы приложения??

[wolmer]

var
SR: TSearchRec;
FindResult: Integer;
s: string;
begin
FindResult := FindFirst('C:\lol\*.exe', faAnyFile, SR);
if FindResult = 0 then
begin
s := SR.Name;
WinExec(PChar(s), SW_SHOW);
end;
end;

Тогда вот так

Код:
var
SR: TSearchRec;
FindResult: Integer;
s: string;
begin
FindResult := FindFirst('C:\lol\*.exe', faAnyFile, SR);
if FindResult = 0 then
begin
s := SR.Name;
WinExec(PChar('C:\lol\'+s), SW_SHOW);
end;
end;

Так как если не указывать полный путь до файла то он не выполнится (если же он не в windows/system32)

А SR.Name возвращает токо имя файла

[wolmer]

Как можно обьявит переменную которую могут исползовать все формы приложения??
Сверху какой либо формы (я в качестве примера взял form1)...
type
TForm1 = class(TForm)
...
private
{ Private declarations }
public
{ Public declarations }
i:integer;
end;

В другой форме объявляешь первую форму (или же ту в которой вписана переменная) и потом пишешь код
К примеру:

Form2

unit Unit2;

interface

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

Form2.Create

Form1.I:=10;
Showmessage(inttostr(Form1.I));

Form1

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
.........
private
{ Private declarations }
public
{ Public declarations }
i:integer;
end;
.........

[mailbrush]

Или глобальные переменные, но их не рекомендую юзать :)

[ZdezBilYa]

Так вот какое дело, если логин с паролем валидные выдаёт ошибку
HTTP/1.1 302 OK
Если не валид - то в ex страница авторизации (что логично)

HandleRedirects объяви true

[Fepsis]

HandleRedirects объяви true
Оба..)) Спасибо..!!! А заголовки как получить, ну чтобы там куки спарсить и т.д. Или куки теперь в IdHTTP1 хранятся..?! Но всё равно, где заголовки..!? :confused:

[ZdezBilYa]

Оба..)) Спасибо..!!! А заголовки как получить, ну чтобы там куки спарсить и т.д. Или куки теперь в IdHTTP1 хранятся..?! Но всё равно, где заголовки..!? :confused:
заголовки вроде так: idHttp.Response.RawHeaders.GetText;

Сохраненные в CookieManager кукисы можно посмотреть так:
for i := 0 to Http.CookieManager.CookieCollection.Count - 1 do
StrPage := StrPage + CookieManager.CookieCollection.Items[i].CookieText + #13#10;

[Mykola-bas]

мне кто нить поможет?

[miqo]

S:string

S:='123654
798798798
5896544465
12598787256212
698754'

Как сделать чтобы каждый элемент массива был равен соответсвующей строке

[slesh]

можно через жопу сделать
sl : TStringList;

sl = TStringList.Create();
sl.text := s;
s.lines.string[] будет тебе массив строк
s.lines.count - кол-во строк.

[Nightmarе]

Подскажите, как через Delphi проиграть Flash ролик в Висте или Win7 ???

Всегда юзал ShockwaveFlashObjects_TLB но он пашет только для XP
Есть ли способы проиграть .swf без установки всяких библиотек программой???

[miqo]

можно через жопу сделать
sl : TStringList;

sl = TStringList.Create();
sl.text := s;
s.lines.string[] будет тебе массив строк
s.lines.count - кол-во строк.

у меня непоказыывает Lines

[wolmer]

у меня непоказыывает Lines
Значит так:
sl : TStringList;

sl = TStringList.Create();
sl.text := s;
sl.string[] // будет тебе массив строк
sl.count //- кол-во строк.

slesh, чуть ошибся мне так кажется

Да и кстати

S:='123654
798798798
5896544465
12598787256212
698754'
Будет все в одну строку,
Так будет правильней

S:='123654'+#13#10+
'798798798'+#13#10+
'5896544465'+#13#10+
'12598787256212'+#13#10+
'698754'
(то есть в неск строк будет S)
(в делфи #13#10 тоже самое что и в C++/php/perl это \r\n то есть перенос на след. строку :) )

[Mykola-bas]

есть процедура

procedure TForm1.html_kod(HTMLDocument: IHTMLDocument2);
var HTMLDocument: IHTMLDocument2;
begin
memo3.Clear;
HTMLDocument := WebBrowser1.Document as IHTMLDocument2;
Memo3.Text := (HTMLDocument.all.Item(1, 0) as IHTMLElement).OuterHTML;
end;
как ее правильно вызвать отсюда ?
procedure TForm1.Button2Click(Sender: TObject); var RegExp: TRegExpr; ss,s: String; i,j,z:integer; HTMLDocument: IHTMLDocument2; begin Z:=StrToInt(edit3.Text); i:=0; While i<= Memo1.Lines.Count do begin if I<=Memo1.Lines.Count then begin RegExp := TRegExpr.Create; RegExp.Expression := '[_a-zA-Z\d\-\.]+@([_a-zA-Z\d\-]+(\.[_a-zA-Z\d\-]+)+)'; if RegExp.Exec(Memo1.lines[i]) then begin edit1.Text:= RegExp.Match[0]; RegExp.Expression := ':([^\s]+)'; if RegExp.Exec(Memo1.lines[i]) then begin ss:=RegExp.Match[0]; Delete(ss, 1, 1); end; edit2.Text:=ss; s:='http://vkontakte.ru/login.php?email='+edit1.text+'&pass='+edit2.text+'&HTTP/1.0'; WebBrowser1.Navigate(s); Sleep(Z); end; I:=i+1; end; end; end;

[wolmer]

Есть символ '
Нужно его программно запихнуть к примеру в Edit1
Как это сделать? (естественно edit1.text:=''' не помогает :D )

[RumShun]

edit1.text:=char(кодсимвола) или chr(код символа)

[Nullsleep]

wolmer, чтобы написать апостроф, нужно написать 2 апострофа :D

Edit1.Text := '''';
Edit1.Text := 'wolmer''s quote';

updt
А вообще вместо этого
edit1.text:=char(кодсимвола) или chr(код символа)
можно сделать проще: Edit1.Text := #код;

[Killerkod]

Mykola-bas, процедура у тебя немного неправильная.
Ты два раза объявляеш одну переменную - HTMLDocument.
Убери строку Var, сразу идет бегин
Объявляй как TForm1.html_kod(Имя дока или файла что у тебя там)
Должно работать

[Seregakz]

народ как сделать на винапи при пост запросе, передачу куков!???

[Nightmarе]

Помогите с небольшим вопросом по флеш, уже час ничего придумать не могу.

Создаю программно флеш форму и проигрываю флешку:

uses ShockwaveFlashObjects_TLB...

...


procedure TForm1.Button5Click(Sender: TObject);
var
Flash : TShockwaveFlash;
begin
Flash := TShockwaveFlash.Create(nil);
Flash.Parent := self;
Flash.ScaleMode:=7;
Flash.Movie:='C:\prank.swf';
end;

Проблема заключается в том, что флешка создаётся на форме в очень маленьком формате, где то 100 на 100, и если только кликнуть на неё ПКМ, то она автоматически выравнивается по форме.
Но естественно надо чтобы при запуске она уже имела размеры формы, а не после клика мышкой по ней...
Что бы я не делал, ни Left ни Top ни width ни height не помогают... Уже все варианты у меня закончились...

[Пуховой]

wolmer, edit1.text := char(39);

[transserg]

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

[NDPrince]

Всем привет, подскажите кто нибудь учебник по дельфи 2007, а то погуглив я ничего не нашёл(

[=Zeus=]

Всем привет, подскажите кто нибудь учебник по дельфи 2007, а то погуглив я ничего не нашёл(
Значит руки того... Вбей в гугл
delphi 2007 учебник

[DreHows]

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

[Dosia]

Когда то давно кодил такое дело:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdAntiFreezeBase, IdAntiFreeze, IdComponent,
IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, IdBaseComponent,
IdMessage;

type
TForm1 = class(TForm)
IdMessage: TIdMessage;
SMTP: TIdSMTP;
IdAntiFreeze1: TIdAntiFreeze;
Button1: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
function SendMail(Smtp:tidsmtp;IdMessage:tIdMessage;Usernam e,Password,Host:string;Port:integer;fromAddress,fr omName,recipientsMailAdress,AttachPath,Subject,Tex t:string):boolean;
var
attach:TidAttachment;
begin
result:=false;
SMTP.AuthenticationType:= atLogin;
SMTP.Username:=Username;
SMTP.Password:=Password;
SMTP.Host:=Host;
SMTP.Port:=Port;
IdMessage.Body.Add(Text);
IdMessage.Subject:=Subject;
IdMessage.From.Address:=fromAddress;
IdMessage.From.Name:=fromName;
IdMessage.Recipients.EMailAddresses:=recipientsMai lAdress;
IdMessage.IsEncoded:=true;
attach:=TIdAttachment.Create(idMessage.MessagePart s,AttachPath);
try
SMTP.Connect;
if SMTP.Connected then
begin
SMTP.Send(IdMessage);
result:=true;
end
else result:=false;
finally
SMTP.Disconnect;
end;
attach.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
opendialog1.InitialDir :=getcurrentdir;
opendialog1.Title := 'Укажите файл который вы хотите отправить';
if opendialog1.Execute = false then exit;
if SendMail(Smtp,idMessage,'egorka100','5555','smtp.m ail.ru',25,'egorka100@mail.ru','Egor','simplemailt est2@mail.ru',opendialog1.FileName,'Hello','Hello world!')= true then showmessage('Your letter has been successfully sent')
else
showmessage('Your letter has not been successfully sent');
end;

end.

Исходный файл проекта (http://dump.ru/file/3484662)

[DreHows]

Благодарю :)
У меня отсутствуют некоторые компоненты, можно пример на стандартных компонентах?

[Dosia]

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

Понравилась поставленная задача, написал прогу, исходники и описание тут. (http://forum.antichat.ru/showpost.php?p=1552469&postcount=70)

ЗЫ: Пока не показывает какая программа работает с файлом.

Благодарю
У меня отсутствуют некоторые компоненты

тут можно скачать используемые мной компоненты (indy) (http://www.indyproject.org/downloads/indy9.0.18_source.zip)

Выбираеш "Component" -> "Install package" -> "Add", указываеш путь до (Indy*0.dpk), где * твоя версия делфи, если больше 7, то ставь 7, дальше я думаю разберешся.

[alexey-m]

Благодарю :)
У меня отсутствуют некоторые компоненты, можно пример на стандартных компонентах?
Вот это погляди http://alekhej-m.narod.ru/software/light_smtp.rar

[sultan08]

как на кнопке сделать направления текста не слева на право,а с верху вниз?типа
Д
е
л
ф
и

[Dosia]

procedure TForm1.FormCreate(Sender: TObject);
var
strCaption:string;
intI:integer;
begin
strCaption:=BitBtn1.Caption;
BitBtn1.Caption:='';
for intI:=length(strCaption) downto 1 do BitBtn1.Caption := strCaption[intI] +char(13)+char(10)+ BitBtn1.Caption
end;

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

http://doctordrad.narod.ru/files/pr/others/bitbtns.JPG

Можно еще через Canvas, но там труднее.

[t04]

можно функцией попроще пользоваться:


function Vertical(const S:String):String;
var
i:LongWord;
begin
if length(S) < 2 then
Result := S;
Result := S[1];
for i := 2 to Length(S) do
Result := Result+#13#10+S[i];
end;


пользоваться так: BitBtn1.Caption:=Vertical('мой текст или переменная');

[Nightmarе]

Помогите с небольшим вопросом по флеш, уже час ничего придумать не могу.

Создаю программно флеш форму и проигрываю флешку:

uses ShockwaveFlashlols_TLB...

...


procedure TForm1.Button5Click(Sender: Tlol);
var
Flash : TShockwaveFlash;
begin
Flash := TShockwaveFlash.Create(nil);
Flash.Parent := self;
Flash.ScaleMode:=7;
Flash.Movie:='C:\prank.swf';
end;

Проблема заключается в том, что флешка создаётся на форме в очень маленьком формате, где то 100 на 100, и если только кликнуть на неё ПКМ, то она автоматически выравнивается по форме.
Но естественно надо чтобы при запуске она уже имела размеры формы, а не после клика мышкой по ней...
Что бы я не делал, ни Left ни Top ни width ни height не помогают... Уже все варианты у меня закончились...
Ответьте на мой ответ!!! © Урал

[Dosia]

Some additions

Actually TShockwaveFlash and some its methods do not always work correctly. For example, the movie does not stretch automatically resizing of a parent window; property Menu does not make disabled the popup menu completely; property PopupMenu does not show the custom menu. Some tips how to expand the TShockwaveFlash possibilities are below.
Fixed visual bugs with resizing

TShockwaveFlash = class (TOleControl)
...
public
Procedure CreateWnd; override;
...

Procedure TShockwaveFlash.CreateWnd;
begin
inherited;
end;

// in main unit
Procedure TMain.OnResize (sender: TObject);
begin
ShockwaveFlash.CreateWnd;
end;

отсюда (http://www.delphiflash.com/library-shockwave-flash.php#a3)

Поправил исходники (http://dump.ru/file/3488153) (скаченные с того же сайта) как сказано там, по - моему оно работает. Но работает со стандартным подходом - присваиваем width,height формы, создается как надо. Потом вызываем процедуру Flash.CreateWnd;


uses ShockwaveFlashlols_TLB...

var
Form1: TForm1;
Flash : TShockwaveFlash;

procedure TForm1.Button5Click(Sender: Tlol);
begin
Flash := TShockwaveFlash.Create(self);
Flash.Parent := self;
Flash.Width :=form1.Width;
Flash.Height :=form1.Height;
Flash.CreateWnd;
Flash.Movie:='C:\prank.swf';
Flash.Play;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
Flash.Width :=form1.Width;
Flash.Height :=form1.Height;
Flash.CreateWnd;
end;


Можно через SendMessage попробовать послать событие нажатия левой кнопки мыши на Flash.

[boooch]

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

[HakaR]

А как можно, чтобы при нажатии на кнопку из реестера удалялась определенная папка??


uses Registry

procedure TForm1.Button2Click(Sender: TObject);
var
Reg: TRegistry;
begin
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_LOCAL_MACHINE;
Reg.DeleteKey('software\test');
end;

[s0l_ir0n]

как на кнопке сделать направления текста не слева на право,а с верху вниз?типа
Д
е
л
ф
и
Button1.Caption:='T'+#13#10+'E'+#13#10+'S'+#13#10+ 'T'; :D

[slesh]

2 Nullsleep не забывай про свойство WordWrap

[xtra]

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

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

[Dosia]

Язык Delphi? Интерфейс нужен?

[xtra]

нет нет нет, язык паскаль. консоль.

[Dosia]

Задание номер 1:


program MATR;


var
Matrix:array[1..5,1..5] of integer;
I,J:integer;
SummaElementov:array[1..5] of integer;
begin
for I:=1 to 5 do begin
for J:=1 to 5 do begin
Matrix[I,J]:=I+J;
write (Matrix[I,J],' ');
SummaElementov[i]:=SummaElementov[i]+ Matrix[I,J];
end;
write (#13#10);
end;

writeln;
for I:=1 to 5 do writeln('Summa elementov stroki ',I,' = ',SummaElementov[I]);

readln;
end.



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

2 3 4 5 6
3 4 5 6 7
4 5 6 7 8
5 6 7 8 9
6 7 8 9 10

Summa elementov stroki 1 = 20
Summa elementov stroki 2 = 25
Summa elementov stroki 3 = 30
Summa elementov stroki 4 = 35
Summa elementov stroki 5 = 40

Задание номер 2:


program STROK;

var
Matrix:array[1..5,1..7] of integer;
Naim,Naib:array[1..5] of integer;
I,J:integer;
begin

randomize;
for I:=1 to 5 do begin
Naim[I]:=10;
Naib[I]:=0;
for J:=1 to 7 do begin
Matrix[I,J]:=random(9)+1; {generim 4icla ot 1 do 9}
write (Matrix[I,J],' ');
IF Naim[I]>Matrix[I,J] then Naim[I]:=Matrix[I,J];
IF Naib[I]<Matrix[I,J] then Naib[I]:=Matrix[I,J];
end;
write (#13#10);
end;

writeln;
writeln('Sorted:');
writeln;

for I:=1 to 5 do begin
for J:=1 to 7 do begin
if I=1 then write(Matrix[I,J],' ');
if I > 1 then
if Naim[I]=Matrix[I,J] then write(Naib[I-1],' ') else write(Matrix[I,J],' ');
end;
write(#13#10);
end;

readln;
end.


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


8 5 2 2 1 5 2
4 9 8 6 4 7 6
3 3 5 3 8 1 7
8 1 7 2 7 6 4
3 9 7 4 9 3 6

Sorted:

8 5 2 2 1 5 2
8 9 8 6 8 7 6
3 3 5 3 8 9 7
8 8 7 2 7 6 4
8 9 7 4 9 8 6


Собрано и тестировалось в Turbo Pacal 7

[xtra]

да.

[xtra]

как же тебя отблагодарить?)))

p.s. только один вопрос, что значит write (#13#10);

[slesh]

write (#13#10);
это тоже самое что и
writeln ();

[xtra]

только компилятор ругнулся и отказался переварить. спасибо большое.

[SITH]

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

[mailbrush]

Создавай два массива, значения которых соответствуют одно одному.
Т.е. первый ('а','б'...'я'), второй ('a','b'...'ya') ну и ищи по элементам второго массива, значения выводи.

[Dosia]

типо транслиттер?

[SITH]

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

[Dosia]

program Translit;

{$APPTYPE CONSOLE}

uses
SysUtils;

const
ENG: array[1..33] of string = ('A','B','V','G','D','E','JO','ZH','Z','I','J','K' ,'L','M','N','O','P','R','S','T','U','F','H','Z',' CH','SH','SHH','"','I','"','YE','JU','JA');
RUSup: array[1..33] of integer = (128, 129, 130, 131 ,132, 133, 240, 134, 135 ,136 ,137 ,138, 139 ,140, 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 159);
RUSlw: array[1..33] of integer = (160, 161, 162, 163, 164, 165, 241, 166, 167, 168, 169, 170, 171, 172, 173, 174, 175, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239);

var
i,b:integer;
strBuff,strOut:string;
begin
writeln('Vvedite slova dlia transliterazii');
readln(strBuff);
for i:=1 to length(strBuff) do begin
b:=1;
strOut:='';
if strBuff[i] <> ' ' then
while b<>length(RUSup)+1 do begin
if ord(strBuff[i])=RUSup[b] then begin
strOut:=UpperCase(ENG[b]);
end;
if ord(strBuff[i])=RUSlw[b] then begin
strOut:=LowerCase(ENG[b]);
end;
inc(b);
end;
if strOut = '' then strOut :=strBuff[i];
write(strOut);
end;

readln;
end.


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


Vvedite slova dlia transliterazii
ОдИн ДВА три ПРОверКА СВязИ123 1 2 3 ПРОВЕрКа123
OdIn DVA tri PROverKA SVjazI123 1 2 3 PROVErKa123


Если вам кажется что код немного кривоват и не оптимизирован - посмотрите на время поста.

Использую массив кодов ascii из - за возникших проблем с существующими функциями перевода русских символов в верхний регистр.

[MaTpOc]

Помогите в заданной последователности целых чисел определить количество и сумму элементов равных 10.

[mailbrush]

var
Form1: TForm1;
my: array[0..9] of integer = (1,15,10,100,50,33,78,10,90,10);
...
procedure TForm1.Button1Click(Sender: TObject);
var
i, count, summ: integer;
begin
count := 0;
for i:=0 to length(my) do
begin
if my[i] = 10 then
begin
count := count + 1;
end;
end;
ShowMessage('В массиве ' + IntToStr(count) + ' элементов, равных 10, общая сумма которых ' + IntToStr(count*10));
end;

[alexey-m]

Подскажите пожалуйста, как можно подсчитать количество уникальных цветов в bitmap и сохранить палитрут цветов?

[axe89]

Чауваки кто может подсказать? вот есть онлайн сниффер hacker-pro.ru вот мне нужно поместить javascript В картинку чтоб послать эту картинку кому нить на мыло и когда он её посмотрит чтоб мне пришли кукисы! Подскажите как нужно сформулировать этот javascript