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

[][yZ]

в делфе в Indy вроде есть парсер xml

[НTL]

Ну вообще это на xml всё написано. Так что юзай любой парсер xml

точно. спс

в делфе в Indy вроде есть парсер xml

Неужели кроме InDy нет лучше?
Всегда найдется unit который будет работать качественнее чем indy

5 минут гугла показали что JAN XML лучше. клац (http://forum.sources.ru/index.php?showtopic=81572&view=findpost&p=600614)

[Tribal_0_o]

Подскажите как внедрить свою dll в чужой процесс?

[_nic]

Можно в VCL сделать такой трюк что бы контролы ненаследовали прозрачность от родительской формы?

[TrueBit]

Подскажите как внедрить свою dll в чужой процесс?
http://www.xakep.ru/post/26796/default.asp

[RDL_Rider]

результат fWsRecv любого потока спихивается в одну глобальную переменную FData...попробуй массив создать. и ещё, Callback функция должна быть такой:
DWORD WINAPI ThreadProc(
__in LPVOID lpParameter );

[iGlass]

Не стал создавать отдельную тему, может кто знает как на WINSOCK получить страницу в стринг лист. Я в сокетах вообще нуб..

Заранее спасибо.

И ещё может кто знает хорошую литературу, статьи по работе с сетью в делфи.

[GlooK]

Не стал создавать отдельную тему, может кто знает как на WINSOCK получить страницу в стринг лист. Я в сокетах вообще нуб..

Заранее спасибо.

И ещё может кто знает хорошую литературу, статьи по работе с сетью в делфи.

const
mstimeout = 15000;
buffsize = 1024;
crlf = #13#10;

var
StrLst: tstringlist;

function fWSRecv(wHost, wRequest: string; wPort: word = 80):string;
var
hSocket: TSocket;
wsData: TWSAData;
hHost: PHostEnt;
hAddr: TSockAddrIn;
hTimeout: TTimeVal;
iRead: integer;
hData: string;
hBuffer: array[0..buffsize] of char;
begin
WSAStartup($202, wsData);
hSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
hHost := gethostbyname(PChar(wHost));
hAddr.sin_family := AF_INET;
hAddr.sin_port := htons(wPort);
hAddr.sin_addr := pinaddr(hHost^.h_addr^)^;
hTimeout.tv_usec := 0;
hTimeout.tv_sec := mstimeout;
setsockopt(hSocket, SOL_SOCKET, SO_RCVTIMEO, @hTimeout, sizeof(ttimeval));
connect(hSocket, hAddr, SizeOf(hAddr));
hData := '';
Send(hSocket, wRequest[1], length(wRequest), 0);
while (TRUE) do
begin
FillChar(hBuffer, SizeOf(hBuffer), 0);
iRead := Recv(hSocket, hBuffer, length(hBuffer), 0);
hData := hData + copy(hBuffer, 0, iRead);
if (iRead <= 0) then break;
end;
CloseSocket(hSocket);
WSACleanup;
result := hData;
end;

begin
StrLst := TStringList.Create();
StrLst.Add(fWSRecv('ya.ru',
'GET /index.php HTTP/1.1' + CRLF +
'Host: ya.ru' + CRLF +
'Connection: close' + CRLF + CRLF));
end.

[Ponchik]

Снова я, уже спрашивал, никто не ответил, но опять надо
tcpclnt1 = TTCpClient
Я делаю tcpclnt1.Receiveln но если нечего читать, прога зависает, как узнать есть чо читать или нет
типа как feof в пыхе

[n1ghtstalker]

Снова я, уже спрашивал, никто не ответил, но опять надо
tcpclnt1 = TTCpClient
Я делаю tcpclnt1.Receiveln но если нечего читать, прога зависает, как узнать есть чо читать или нет
типа как feof в пыхе

хз , как то в delphях ещё 0. но если нет предопр. оператора,просто open и ищешь элементы.

[Ponchik]

хз , как то в delphях ещё 0. но если нет предопр. оператора,просто open и ищешь элементы.
не не, я так ничё непонял, покажи пример =\
Вот в пыхе на пример
while(!feof($socket)) читать ответ
А вот в дельфи как :o
=========
Всё, забейте, переписал прогу на пых, работает в мильён раз быстрее :D

[iGlass]

Вопрос не совсем по Delphi, но..

У меня возникла сложность, запускаю службу Telnet, Запускаю cmd коннекчусь, но какие стандартные логин и пароль? Вводил имя учётки но на ней нет пароля.. В общем если кто знает, подскажите.

Заранее спасибо!

P.S А то я уже себе всю голову сломал...

[iGlass]

Хочу записать в файл N кол-во символов.

Вот код:


{....................}
const
Text = 'Это я хочу записать в файл!'; // Отсюда буду писать

var
FileHandel:Integer;
DS:integer;

begin
DS:=50; // Кол-во символов
FileHandel := FileCreate(Pchar('samplefile.samp'),0);
FileOpen('samplefile.samp',fmOpenReadWrite);
FileWrite(FileHandel,Text,DS);
FileClose(FileHandel);
end.



Так вот вопрос, как программно посчитать сколько символов записали и сколько осталось?

Чтобы не указывать переменную DS (Сколько мне надо записать)

Заранее спасибо!

[iGlass]

Уже разобрался в чём причина.. ) Если кому интересно то вот решение:

FileWrite(FileHandel,Text,Length(Text));

[090808]

procedure TForm1.Button8Click(Sender: TObject);
var StrPage, ssylka:string;
Data:TstringList;
begin
idhttp1.HandleRedirects:=true;
StrPage:=idhttp1.Get('http://***.jino.ru/panel/rcon.php/');
Data:=TstringList.Create;
Data.Add('ip=**.**.**.**');
Data.Add('port=7777');
Data.Add('pass=*****');
Data.Add('cmd=chat');
Data.Add('submit=Отправить запрос');
StrPage:=idhttp1.Post(ssylka, Data);
Data.Free;
end;


После этого всего нужно получить в memo1, ответ от страницы


Заранее спасибо.

[Nightmarе]

Помогите разобратсья с проблеммой. Есть функция на WinSock для отправки GET запроса на сервер, мне нужно запустить её в бесконечном цикле, чтобы она так и слала запрос на сервер.
Но проблемма в том, что если её запустить в бесконечном цикле, то программа начинает открывать огромное количество соединений, и до тех пор, пока компьютер окончательно не повиснет.
Помогите кто сможет, вот функция:
function fWSRecv(wHost, wRequest: string):string;
var
hSocket: TSocket;
hHost: PHostEnt;
hAddr: TSockAddrIn;
hTimeout: TTimeVal;
iRead: integer;
hBuffer: array[0..buffsize] of char;
begin

hSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
hHost := gethostbyname(PChar(wHost));
hAddr.sin_family := AF_INET;
hAddr.sin_port := htons(80);
hAddr.sin_addr := pinaddr(hHost^.h_addr^)^;
hTimeout.tv_usec := 0;
hTimeout.tv_sec := mstimeout;
setsockopt(hSocket, SOL_SOCKET, SO_RCVTIMEO, @hTimeout, sizeof(ttimeval));
connect(hSocket, hAddr, SizeOf(hAddr));

Send(hSocket, wRequest[1], length(wRequest), 0);
while (TRUE) do
begin
FillChar(hBuffer, SizeOf(hBuffer), 0);
iRead := Recv(hSocket, hBuffer, length(hBuffer), 0);
// hData := hData + copy(hBuffer, 0, iRead);
if (iRead <= 0) then break;
end;
CloseSocket(hSocket);
//result := hData;
end;

Вызываю так:
WSAStartup($202, wsData);
fWSRecv('localhost',
'GET /log/ass.php' + #13#10 +
'Host: localhost' + #13#10 +
'User-Agent: Mozilla/5.0' + #13#10 +
'Accept: text/html' + #13#10 +
'Accept-Language: ru' + #13#10 +
'Accept-Charset: windows-1251' + #13#10 +
'Connection: close' + #13#10#13#10);

Где бы я не ставил цикл "while true do", хоть в самой функции, хоть перед вызовом fWSRecv, всё одно и тоже. Данные шлёт, но не долго, пока комп не упадёт =))
Что тут можно сделать, чтобы он бесконечно посылал запрос на сервер при этом не нагружая компьютер и не открывая кучу ненужных соединений?

[GlooK]

Где бы я не ставил цикл "while true do", хоть в самой функции, хоть перед вызовом fWSRecv, всё одно и тоже. Данные шлёт, но не долго, пока комп не упадёт =))
Что тут можно сделать, чтобы он бесконечно посылал запрос на сервер при этом не нагружая компьютер и не открывая кучу ненужных соединений?
Это ж моя функция))

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

while (TRUE) do
begin
FillChar(hBuffer, SizeOf(hBuffer), 0);
iRead := Recv(hSocket, hBuffer, length(hBuffer), 0);
// hData := hData + copy(hBuffer, 0, iRead);
if (iRead <= 0) then break;
end;

[GlooK]

После этого всего нужно получить в memo1, ответ от страницы


Заранее спасибо.
Добавь в конец строку
Memo1.Lines.Add(StrPage);

[Nightmarе]

Это ж моя функция))

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

while (TRUE) do
begin
FillChar(hBuffer, SizeOf(hBuffer), 0);
iRead := Recv(hSocket, hBuffer, length(hBuffer), 0);
// hData := hData + copy(hBuffer, 0, iRead);
if (iRead <= 0) then break;
end;

К сожалению не помогает, если ещё есть варианты, просьба написать.

[[stranger]]

не знаю..
в таком виде:
function fWSRecv(wHost, wRequest: string):string;
var
hSocket: TSocket;
hHost: PHostEnt;
hAddr: TSockAddrIn;
hTimeout: TTimeVal;
begin

hSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
hHost := gethostbyname(PChar(wHost));
hAddr.sin_family := AF_INET;
hAddr.sin_port := htons(80);
hAddr.sin_addr := pinaddr(hHost^.h_addr^)^;
hTimeout.tv_usec := 0;
hTimeout.tv_sec := 10;
setsockopt(hSocket, SOL_SOCKET, SO_RCVTIMEO, @hTimeout, sizeof(ttimeval));
connect(hSocket, hAddr, SizeOf(hAddr));

Send(hSocket, wRequest[1], length(wRequest), 0);
CloseSocket(hSocket);
end;
все работает!

ЗЫ: shttp говорит bad request

что за переменная "mstimeout"?

[Nightmarе]

']не знаю..
в таком виде:

все работает!

ЗЫ: shttp говорит bad request

что за переменная "mstimeout"?
Конечно работает.
У меня был вопрос в том, как сделать чтобы при бесконечном цикле не открывал по миллиёну соединений, после чего комп виснет примерно за 3 секунды.
Может кто знает как устранить проблемму?

[[stranger]]

Конечно работает.
У меня был вопрос в том, как сделать чтобы при бесконечном цикле не открывал по миллиёну соединений, после чего комп виснет примерно за 3 секунды.
Может кто знает как устранить проблемму?
я имею в виду что работает так как тебе надо..

[Nightmarе]

']я имею в виду что работает так как тебе надо..
Попробуй её:
while true do
fWSRecv();

и через 5 секунд компостер повиснет окончательно.

я пока тут тесты с этими соксами провожу, уже за 2 дня 40 раз комп повис, приходилось перезагрузать.

[[stranger]]

вот что говорит tcpview спустя 3 минуты:
http://wmd.net.ua/files/1.png
ты на какой сервер запросы шлешь?
и чему равняется mstimeout?

[Nightmarе]

']вот что говорит tcpview спустя 3 минуты:
http://wmd.net.ua/files/1.png
ты на какой сервер запросы шлешь?
и чему равняется mstimeout?
и на локалхост, и на свой сайт со статистикой.

const
mstimeout = 10000;
buffsize = 1024;
у меня лично так

[[stranger]]

я имел в виду "апач или nginx или еще какой-то зверь.."
апач сдох от 5 минут этих запросов, а shttp нормально работает!

[Nightmarе]

']я имел в виду "апач или nginx или еще какой-то зверь.."
апач сдох от 5 минут этих запросов, а shttp нормально работает!
везде апач.

[[stranger]]

вот что получается:
апач: сервер умирает сразу, на клиенте немерено открытых соединений
апач + nginx, nginx - front-end: сервер держится чуть дольше за счет ограничения на кол-во подключений с одного хоста nginx`ом, но все равно падает, на клиенте немерено открытых соединений
nginx: 2 соединения как на сервере, так и на клиенте, независимо от времени
SHTTP: до 4-х соединений, как на сервере так и на клиенте

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

[GlooK]

везде апач.
Мейби у тебя в винде ограничение на 10 потоков?

[090808]

Добавь в конец строку
Memo1.Lines.Add(StrPage);

Спсибо помогло, но оно добовляет исходник страницы, а как сделать чтобы просто текст был?

[GlooK]

Спсибо помогло, но оно добовляет исходник страницы, а как сделать чтобы просто текст был?
Memo1.Lines.Text := StrPage;

[W!z@rD]

заменить <br> на #13#10

=\ это тебе не html

[BenZeR]

procedure TForm1.startClick(Sender: TObject);
begin
for I := 0 to 1 do
begin
icqclient1.UIN:=uin2[i];
icqclient1.Password:=pass2[i];
icqclient1.Login();
icqclient1.ChangePassword('ipc');
icqclient1.LogOff;
ShowMessage('ok');
end;
end;


Собственно вопрос, почему не коннектится к серверу и не меняет пасс?
//юзаю TICQClient

[wolmer]

Данные шлёт, но не долго, пока комп не упадёт =))
Что тут можно сделать, чтобы он бесконечно посылал запрос на сервер при этом не нагружая компьютер и не открывая кучу ненужных соединений?
Попробуй из CreateThread вызывать свою функцию (в цикле while (если бесконечно требуется куда то слать пакеты))(ибо была такая же проблема (программа висла (а не перезагр. комп.)))

На счет будет ли нагружать комп. -> не знаю

[Nightmarе]

У меня проблемма не в потоках, а в одной функции.
Я не использую потоки, мне просто надо сделать так, чтобы через WinSock посылался запрос в бесконечном цикле.
делать задержку в 1 - 10 секунд так-же не вариант.
нужен бесконечный цикл без задержек и открытия кучи соединений.

[wolmer]

У меня проблемма не в потоках, а в одной функции.
Я не использую потоки, мне просто надо сделать так, чтобы через WinSock посылался запрос в бесконечном цикле.
делать задержку в 1 - 10 секунд так-же не вариант.
нужен бесконечный цикл без задержек и открытия кучи соединений.
Хорошо, если winsock+while открывает так много соединений, то просто пиши код чтобы ждал завершения функции и начинал заного с функции (больше не знаю как помочь):
Пиши в uses -> SYNCOBJS

Заводи переменную cs:TCriticalSection;
(на всю программу)
(и в formcreate пиши -> cs:=tcriticalsection.create;)

Ты вызываешь функцию в while цикле как я понял, верно? Если да то код должен был примерно таким:
while true do
begin
fWSRecv('localhost',
'GET /log/ass.php' + #13#10 +
'Host: localhost' + #13#10 +
'User-Agent: Mozilla/5.0' + #13#10 +
'Accept: text/html' + #13#10 +
'Accept-Language: ru' + #13#10 +
'Accept-Charset: windows-1251' + #13#10 +
'Connection: close' + #13#10#13#10);
end;

Теперь берешь и дополняешь его:
while true do
begin
cs.Enter;
fWSRecv('localhost',
'GET /log/ass.php' + #13#10 +
'Host: localhost' + #13#10 +
'User-Agent: Mozilla/5.0' + #13#10 +
'Accept: text/html' + #13#10 +
'Accept-Language: ru' + #13#10 +
'Accept-Charset: windows-1251' + #13#10 +
'Connection: close' + #13#10#13#10);
cs.Leave;
end;

Тем самым он будет ждать пока функция завершится, как она завершилась -> стартует заного! (или же попробуй еще cs.Leave; поставить в конце функции (если выше приведенный код -> не канает))

По другому -> увы не знаю как сделать

[AlexTheC0d3r]

Попробуй её:
while true do
fWSRecv();

и через 5 секунд компостер повиснет окончательно.

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


function fWSRecv(wHost, wRequest: string):string;
var
hSocket: TSocket;
hHost: PHostEnt;
hAddr: TSockAddrIn;
hTimeout: TTimeVal;
iRead: integer;
hBuffer: array[0..buffsize] of char;
begin

hSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
hHost := gethostbyname(PChar(wHost));
hAddr.sin_family := AF_INET;
hAddr.sin_port := htons(80);
hAddr.sin_addr := pinaddr(hHost^.h_addr^)^;
hTimeout.tv_usec := 0;
hTimeout.tv_sec := mstimeout;
setsockopt(hSocket, SOL_SOCKET, SO_RCVTIMEO, @hTimeout, sizeof(ttimeval));
connect(hSocket, hAddr, SizeOf(hAddr));

while (TRUE) do
begin // МММ??
Send(hSocket, wRequest[1], length(wRequest), 0);
FillChar(hBuffer, SizeOf(hBuffer), 0);
iRead := Recv(hSocket, hBuffer, length(hBuffer), 0);
// hData := hData + copy(hBuffer, 0, iRead);
if (iRead <= 0) then break;
end;
CloseSocket(hSocket);
//result := hData;
end;

[Nightmarе]

Спасибо за помощь. Протестировал.
wolmer, в твоём примере как было куча соединений, так и остается :(
AlexTheC0d3r, в твоем примере запрос отсылается всего 1 раз. хоть цикл и стоит, но он не работает.

[GlooK]

Спасибо за помощь. Протестировал.
wolmer, в твоём примере как было куча соединений, так и остается :(
AlexTheC0d3r, в твоем примере запрос отсылается всего 1 раз. хоть цикл и стоит, но он не работает.
Ну так вопрос решен?

[Nightmarе]

Ну так вопрос решен?
Если не работает, то логично что не решен.

[wolmer]

Если не работает, то логично что не решен.
Вот самописная (ибо маленько не понимаю как функция у тебя работает):
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
hworktread:THandle;

implementation

{$R *.dfm}

procedure GetHost();
var
addr:sockaddr_in;
sock:tsocket;

send1:string;
send1buffer, recv1buffer:array [1..4096] of char;
dsize:dword;
begin
sock:=socket(af_inet, sock_stream, 0);
addr.sin_family:=AF_INET;
addr.sin_addr.S_addr:=inet_addr('94.103.89.31');
addr.sin_port:=htons(80);
form1.Memo1.Clear;

if connect(sock, addr, sizeof(addr))=0 then
begin
send1:='GET http://pr-cy.ru/ HTTP/1.0'+#13#10+
'User-Agent: Opera/9.80 (Windows NT 5.1; U; en) Presto/2.2.15 Version/10.20'+#13#10+
'Host: pr-cy.ru'+#13#10+
'Cookie: 1=1;'+#13#10+
'Cookie2: $Version=1'+#13#10+
'Connection: Keep-Alive'+#13#10+#13#10;
CopyMemory(@send1buffer, pchar(send1), length(send1));
send(sock, send1buffer, sizeof(send1buffer), 0);
repeat
dSize:=recv(sock, recv1buffer, 4096, 0);
Application.ProcessMessages; //В ЭТОЙ СТРОКЕ -> ВСЯ ФИШКА, ЕСЛИ ЕЕ УБРАТЬ, ПРОГРАММА ЗАВИСНЕТ
form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+rec v1buffer;
until (dSize = 0) or (dSize = SOCKET_ERROR);
end;
closesocket(sock);
form1.Label1.Caption:=inttostr(strtoint(form1.Labe l1.Caption)+1);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
dummy:Cardinal;
i:integer;
begin
while true do
begin
gethost;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
ws:wsadata;
begin
WSAStartup($101, ws);
end;

end.
Работает нормально

//Переделаешь как тебе нужно, думаю не составит проблем

[Nightmarе]

Вот самописная (ибо маленько не понимаю как функция у тебя работает):
Работает нормально

//Переделаешь как тебе нужно, думаю не составит проблем
Странно, у меня при запуске просто виснет рпограмма и все. Даже не пытается вылезти в интернет.

[AlexTheC0d3r]

var i:integer;
...................
connect(hSocket, hAddr, SizeOf(hAddr));

for i:=0 to 2147483646 do begin
Send(hSocket, wRequest[1], length(wRequest), 0);
sleep(10);
end;

FillChar(hBuffer, SizeOf(hBuffer), 0);
iRead := Recv(hSocket, hBuffer, length(hBuffer), 0);
// hData := hData + copy(hBuffer, 0, iRead);
if (iRead <= 0) then break;
CloseSocket(hSocket);


сколько раз отошлет?
поэксперементируй с задержкой...

[wolmer]

for i:=0 to 2147483646 do begin
Send(hSocket, wRequest[1], length(wRequest), 0);
sleep(10);
end;
а вот так уже делать не правильно (если не ошибаюсь)

[AlexTheC0d3r]

а вот так уже делать не правильно

почему?

[cLauZ]

Есть откомп. дельфийский файл в exe , исходников нету=(
Нада сменить кнопочку...точнее надпись на ней...ресурс хакер не помог...
Как мне ент сделать?!народ нужно срочно до утра!!!

[[stranger]]

попробуй winhex

[НTL]

Как сделать всплывающие окно в правом нижнем углу? (Как например у: icq, qip, nod32, каперский, и т.д.)

ps: Не знаю даже что гуглить...

[=Zeus=]

Просто форму сделай и все. На ней таймер. В ОнКриейт пропиши, чтоб помешалась в правый нижний угол, но ниже нижней границы экрана. А по таймеру подымай вверх.

[GlooK]

Как сделать всплывающие окно в правом нижнем углу? (Как например у: icq, qip, nod32, каперский, и т.д.)

ps: Не знаю даже что гуглить...
Как правильно сказал зевс, сделай окно.

Как то делал такую фишку.
Вот пример: http://app.shacknet.nu/remindsave.zip

[Nightmarе]

function fWSRecv():string;
var
hSocket: TSocket;
hHost: PHostEnt;
hAddr: TSockAddrIn;
hTimeout: TTimeVal;
samzapros,kuda:string;
begin
kuda:='localhost';
samzapros:='GET /log/ass.php' + #13#10 +
'Host: localhost' + #13#10 +
'User-Agent: Mozilla/5.0' + #13#10 +
'Accept: text/html' + #13#10 +
'Accept-Language: ru' + #13#10 +
'Accept-Charset: windows-1251' + #13#10 +
'Connection: close' + #13#10#13#10;

hSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
hHost := gethostbyname(PChar(kuda));
hAddr.sin_family := AF_INET;
hAddr.sin_port := htons(80);
hAddr.sin_addr := pinaddr(hHost^.h_addr^)^;
hTimeout.tv_usec := 0;
hTimeout.tv_sec := mstimeout;


while true do begin
setsockopt(hSocket, SOL_SOCKET, SO_RCVTIMEO, @hTimeout, sizeof(ttimeval));
connect(hSocket, hAddr, SizeOf(hAddr));
Send(hSocket, samzapros[1], length(samzapros), 0);
CloseSocket(hSocket);
sleep(2000);
end;
end;
Ну никак не понятно где тут ошибка.
Я взял в цикл именно ту часть, которая собственно и отвечает за отправку данных на сервер, остальная часть до цикла на мой взгляд всего-лишь назначение переменых, помоему достаточно всего 1 раз их назначить и все...
Если ошибаюсь поправьте.
А данный код отсылает всего 1 запрос, после чего программа просто виснет и все.

Если же в цикле взять весь код, то начинает слать как и положенно через 2 секунды, и открывать множество соединений, для 2 секунд он открывает 5 штук. через 5 секунд ещё 4 штуки и т.д....

Что то мне подсказывает, что команды CloseSocket(hSocket); вовсе не достаточно, надо видимо закрывать что то ещё.. но что???

[[stranger]]

код абсолютно рабочий!
а если он не работает у тебя. значит проблема на твоей стороне!
function fWSRecv(wHost, wRequest: string):string;
var
hSocket: TSocket;
hHost: PHostEnt;
hAddr: TSockAddrIn;
hTimeout: TTimeVal;
begin

hSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
hHost := gethostbyname(PChar(wHost));
hAddr.sin_family := AF_INET;
hAddr.sin_port := htons(80);
hAddr.sin_addr := pinaddr(hHost^.h_addr^)^;
hTimeout.tv_usec := 0;
hTimeout.tv_sec := 0;
setsockopt(hSocket, SOL_SOCKET, SO_RCVTIMEO, @hTimeout, sizeof(ttimeval));
connect(hSocket, hAddr, SizeOf(hAddr));
Send(hSocket, wRequest[1], length(wRequest), 0);
CloseSocket(hSocket);
end;

[Nightmarе]

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

[НTL]

Как закрыть form1, и открыть form2?
Требуется сделать from2 главной, но как?

Если написать:

Form1.Close;
form2.Show;

То программа закроется, т.к. закрылось главная форма

А если так:

form2.Show;
Form1.Close;

То первая форма не закроется...

[][yZ]

мб form1.hide;
form2.show;

[НTL]

А закрыть не как?

[AlexTheC0d3r]

А закрыть не как?
мб изменять свойство visible?

[[stranger]]

Требуется сделать from2 главной, но как?
Project -> Options -> main form

[НTL]

']Project -> Options -> main form

А в ходе выполнение кода можно сменить? (Программным способом)

[=Zeus=]

А в ходе выполнение кода можно сменить? (Программным способом)
Не могу утверждать, но я ни разу не встречал такого способа. Да и подумать - в приложении есть родительская форма. Если ее закрыть - то все приложение закроется.

[Андрей021]

ShellExecute(0,'open','cmd.exe','/c ipconfig/all ipconfig_all.txt','C:\Windows\system32\',SW_HIDE);

Как вместо ipconfig/all вставить переменную? :confused:

[НTL]

ShellExecute(0,'open','cmd.exe','/c ipconfig/all ipconfig_all.txt','C:\Windows\system32\',SW_HIDE);

Как вместо ipconfig/all вставить переменную? :confused:

'/c '+s+' ipconfig_all.txt'

[Microdel]

Доброго времени суток.
есть компонент idhttpproxyserver.
Как сделать так, чтобы в memo отображались все запросые, которые проходили через это прокси?

[W!z@rD]

AlexTheC0d3r

hide это и есть visible:=false;

[090808]

procedure TForm4.Button2Click(Sender: TObject);
var StrPage, ssylka:string;
Data:TstringList;
begin
idhttp1.HandleRedirects:=true;
StrPage:=idhttp1.Get('http://ya.ru);
StrPage:=idhttp1.Post(ssylka, Data);
Memo2.Lines.Text := StrPage;
Data.Free;


Как допустим получить в label1 то что находится в скобках <title> НУЖНО ЧТОБ ЭТОТ ТЕКСТ ВЫВЕЛО В MEMO1</title>

[GlooK]

procedure TForm4.Button2Click(Sender: TObject);
var StrPage, ssylka:string;
Data:TstringList;
begin
idhttp1.HandleRedirects:=true;
StrPage:=idhttp1.Get('http://ya.ru);
StrPage:=idhttp1.Post(ssylka, Data);
Memo2.Lines.Text := StrPage;
Data.Free;


Как допустим получить в label1 то что находится в скобках <title> НУЖНО ЧТОБ ЭТОТ ТЕКСТ ВЫВЕЛО В MEMO1</title>

function fWSCut(wData, wStart, wEnd: string):string;
var
wOutData, wDelete: string;
begin
wOutData := StrPos(PChar(wData), PChar(wStart));
Delete(wOutData, 1, Length(wStart));
wDelete := StrPos(PChar(wOutData), PChar(wEnd));
Delete(wData, 1, Length(wData)-Length(wDelete));
Delete(wOutData, Length(wOutData) - Length(wDelete) + 1, Length(wDelete));
result := wOutData;
end;

Пример:
Memo2.Lines.Text := fWSCut(StrPage, '<title>', '</title>');

[090808]

ICQClient1.UIN:=111111; // (Номер ICQ)
ICQClient1.Password:='12345'; // Пароль от этого номера


а как например Номер ICQ брать из edit1 и пароль из edit2?

[[Dezzter]]

icq_num := StrToInt(Edit1.Text);
icq_pass := StrToInt(Edit2.Text);

[НTL]

[Dezzter], зачем пасс в int переводить?

ICQClient1.UIN:=StrToInt(form1.edit1.text);
ICQClient1.Password:=form1.edit1.text;

[090808]

']
icq_num := StrToInt(Edit1.Text);
icq_pass := StrToInt(Edit2.Text);
Да, пасс действительно в инт переводить не нужно было :)

[Nightmarе]

Подскажите пожалуйста как програмно (через Delphi) включить микрофон?
Например по умолчанию там стоит галочка Выкл.
Как её включить? Нигде пример реализации найти не могу.

[=Zeus=]

Подскажите пожалуйста как програмно (через Delphi) включить микрофон?
Например по умолчанию там стоит галочка Выкл.
Как её включить? Нигде пример реализации найти не могу.
Slesh когда-то писал "MicSpy". Типа прослушка через микрофон. Поищи по форуму, может тебе поможет. Там вроде были исходы, а может и нет...

[Nightmarе]

я про прослушку спрашивал?

[Jingo Bo]

Подскажите пожалуйста как програмно (через Delphi) включить микрофон?
Например по умолчанию там стоит галочка Выкл.
Как её включить? Нигде пример реализации найти не могу.
Вот, держи, модуль AMixer.pas

Создаёшь класс TAudioMixer, потом в свойстве Destinations переходишь на первый Destination(воспроизведение), там ищешь в массв-свойстве Connections микрофон(по типу) и потом как только соединение найдёшь вызываешь <созданы_миксер>.setMute(destionation, connection, true); destionation - обычно в 0(воспроизведение), connection - индекс нйденого микрофона.

http://slil.ru/28632240

[Nightmarе]

Вот, держи, модуль AMixer.pas

Создаёшь класс TAudioMixer, потом в свойстве Destinations переходишь на первый Destination(воспроизведение), там ищешь в массв-свойстве Connections микрофон(по типу) и потом как только соединение найдёшь вызываешь <созданы_миксер>.setMute(destionation, connection, true); destionation - обычно в 0(воспроизведение), connection - индекс нйденого микрофона.

http://slil.ru/28632240
У меня так:

procedure TForm1.Button1Click(Sender: TObject);
var
lol:TAudioMixer;
begin
lol:=TAudioMixer.Create(nil);
lol.Destinations.Connections
end;

Отсутствует Connections ;(

[Nightmarе]

То есть через это конкретно микрофон не включить? а только наобум пробовать?
Вот такой код:
var
lol:TAudioMixer;
begin
lol:=TAudioMixer.Create(nil);
lol.SetMute(0,1,false);
end;

включает синтезатор (режим true его отключает), а чтобы включить микрофон это надо цифры наобум чтоли втыкать и никак не узнать точное расположение микрофона?

[wolmer]

nightmare, вообщем смотри тут:
forum.delphiarea.com/viewtopic.php?p=1725#1725

там достаточно понятно объяснили как включать микрофон

[Jingo Bo]

procedure MicMute(Value : Boolean);
Var ta : TAudioMixer;
i, j : Integer;
finded : Boolean;
begin
try
ta := TAudioMixer.Create(nil);
ta.MixerId := 0;
finded := false;
for i := 0 to ta.Destinations.Count - 1 do
Begin
if UpperCase(Copy(ta.Destinations.Destination[i].Data.szName, 1, 6)) = 'VOLUME' then
for j := 0 to ta.Destinations.Destination[i].Connections.Count - 1 do
if ta.Destinations.Destination[i].Connections.Connection[j].Data.dwComponentType = 4099 then
Begin
finded := true;
Break;
end;
if finded then Break;
end;
if finded then
ta.SetMute(i, j, Value) else
ShowMessage('Ìèêðîôîí íå íéäåí');
finally
ta.Free;
end;
end;

Вот так

[Nightmarе]

Jingo Bo, к сожалению данный код у меня не работает ;(

[Jingo Bo]

Я у себя кстати не проверял:)Может накосячил, щас проверю. Кстати а на запись или воспроизведение надо?

Правка : всё прекрасно работает, если тебе не на вопроизведение а на запись, то поменяй строчку

if UpperCase(Copy(ta.Destinations.Destination[i].Data.szName, 1, 6)) = 'VOLUME' then

на

if UpperCase(Copy(ta.Destinations.Destination[i].Data.szName, 1, 6)) = 'RECORD' then

[Nightmarе]

Я у себя кстати не проверял:)Может накосячил, щас проверю. Кстати а на запись или воспроизведение надо?
имено на воспроизведение, на микрофон если он выключен чтобы его включить.

[Jingo Bo]

Кстати, у тебя может быть несколько микшеров? Тогда в ta.MixerId нужно писать другой ID [0..5] обычно

[Nightmarе]

Кстати, у тебя может быть несколько микшеров? Тогда в ta.MixerId нужно писать другой ID [0..5] обычно
Ага, у меня так оно и есть, ситуация поправимая?
Тока мне главное чтобы работало и так и так, я же не под свой комп подстраиваю, на своём тока тестирую

[Jingo Bo]

Ну дык перебором микшеров получилось?

[Nightmarе]

Ну дык перебором микшеров получилось?
Перебором тоже ничего не дало ;(

[090808]

if (html_tag.item(i).value='123') then
html_tag.item(i).click;

там где 123 там кнопка нажатие на неё, а как сделать чтоб нажимало не по названию а нажимало именно javascript:postComment();


тоесть как в dephi выполнить javascript ?^_^

[W!z@rD]

в Delphi нет встроенного JS интерпретатора, пока.

html_tag что это за объект?

[090808]

Как сделать например чтоб при нажатию на кнопку нажималось javascriptostComment();

[090808]

все ок. решил проблему: webbrowser1.Navigate('javascript:postComment();');

[GhostOnline]

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

TMyClass = class
private
FCritSec : TRTLCriticalSection;


procedure TMyClass.SomeMethod();
begin
EnterCriticalSection(FCritSec);
try
//тут некоторые действия
finally
leaveCriticalSection(FCritSec);
end;
end;

[wolmer]

Можно ли в делфи 7 создать структуру? (типа как в C++)
Если да то как?

[GhostOnline]

можно
в разделе type например:

TMyStruct = record
I : Integer;
Str : String;
Count : Float;
.....
end;

Потом объявляешь переменную этого типа:

var
Struct : TMyStruct

И используешь:

begin
Struct.I := 0;
.....

[Twoster]

Ребята, очень нужен компонент или просто юнит с реализацией протокола mail.ru agent, скачал один компонент (http://yxu.org.ru/files/client.rar) не робит походу... буду очень благодарен. ;)

[denjf]

Сталкнулся с таким приколом первый раз и затупил...

procedure TForm1.FormCreate(Sender: TObject);
var
msf:textfile;
mes:string;
begin
assignfile(msf,'msgs.txt');
reset(msf);
while not Eof(msf) do
begin
readln(msf,mes);
form1.Edit1.Text:=mes;

{Здесь мне надо менять form1.Edit2.Text, form1.Edit3.Text и т.д. Как это зделать???}
end;

end;

[slesh]

Как вариант - задать для этих эдитов свойство tag тем самым пронумеровав их.
Затем пробежаться по элементам формы и проверь нужный tag и записывать в этот элемент

[Nizhegorodets]

Поставил семерку и столкнулся с проблемой, что паскаль не хочет разворачиваться на весь экран.Не подскажите как решить эту проблему?

[=Zeus=]

Поставил семерку и столкнулся с проблемой, что паскаль не хочет разворачиваться на весь экран.Не подскажите как решить эту проблему?
Турбо паскаль развернуть? Alt+Enter

[DimkO]

Турбо паскаль развернуть? Alt+Enter
это не совсем то,когда у меня на ноуте была виста,я тоже не мог паскаль развернуть на весь экран,и все только пожимали плечами,в ХР все отлично:)
наверное более новые версии OS уже не поддерживают такие программные продукты с их полной функциональностью))

[alexey-m]

Сталкнулся с таким приколом первый раз и затупил...

procedure TForm1.FormCreate(Sender: TObject);
var
msf:textfile;
mes:string;
begin
assignfile(msf,'msgs.txt');
reset(msf);
while not Eof(msf) do
begin
readln(msf,mes);
form1.Edit1.Text:=mes;

{Здесь мне надо менять form1.Edit2.Text, form1.Edit3.Text и т.д. Как это зделать???}
end;

end;

TEdit(FindComponent('Edit'+IntToStr(i))).Text:=mes ;

[fenixelite]

DimkO, странно то как у тебя вообще TP на Win7 запустился Оо. Я только из под VM могу работать.......

[DimkO]

DimkO, странно то как у тебя вообще TP на Win7 запустился Оо. Я только из под VM могу работать.......
а я и не говорил что у меня сейчас win7!я висту перебил на хр,считаю что программистам намного важнее увеличить производительность своей системы,а не улучшить "визуальные эффекты" :p

[fenixelite]

DimkO, ой, я твой пост случайно спутал с постом Nizhegorodets. Ну виста это вообще отдельная тема :) А вот Вин7 приятно удивила, все работает быстро, без нареканий.

Nizhegorodets. Расскажи пж как это ты TP на Win7 запустил? DosBox или VM?

[wolmer]

Есть стринг переменная вида: x*x-x-5

Как вырезать третий X и поместить в другую переменную (вида стринг)? (т.е. который между минусами) (ах да, знаки в "уравнении" могут быть любыми!)

[-PsychonauT-]

есть компоненты: edit1, label1, button1
как расписать так, что бы вводимый текстовой текст в edit1 (например 1) был равен 3,4
(2 = 3,4*2)

[krypt3r]

Edit1.ReadOnly := true;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: char);
var
number : Real;
begin
number := 3.4 * StrToFloat (Key);
Edit1.Text:=FloatToStr(number);
end;

[fenixelite]

Есть стринг переменная вида: x*x-x-5 Вместо X будет введенно число? Если это квадратного уравнение, то b = только 1 или могут быть другие числа? Напимер x*x-5*x-5 ? Уточни условие

[RAINUR2]

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

[Dosia]

function GetCursorPos(var Point: TPoint);

Пример:

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
CursorPosition:TPoint;
begin
getcursorpos(CursorPosition);
edit1.Text := 'X = ' + inttostr(CursorPosition.X) + ' Y = ' + inttostr(CursorPosition.Y);
end;

[wolmer]

могут быть другие числа? Напимер x*x-5*x-5 ?
Совершенно верно (да это квад. урав.)

[-PsychonauT-]

хочу создать процедуру на радиогруппу

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
RadioGroup1.ItemIndex:=0;
label3.Visible:=true;
label2.Visible:=true;
edit1.Visible:=true;
edit2.Visible:=true;
RadioGroup1.ItemIndex:=1;
label3.Visible:=false;
label2.Visible:=false;
label4.Visible:=true;
label5.Visible:=true;

почему она начинает тупить?
моя цель - это создать радиогруппу, при которой ткнув на item0 раскрываются некоторые label's и edit's, а некоторые скрываются
тоже самое при клацанье на item1

[W!z@rD]

label3.Visible:=true;
label2.Visible:=true;
edit1.Visible:=true;
edit2.Visible:=true;

аааа тру код!

var b: Boolean;
..
b:=RadioGroup1.Checked;
label3.Visible:=b;
label2.Visible:=b;
edit1.Visible:=b;
edit2.Visible:=b;

...

[fenixelite]

wolmer, в асю пиши, подскажу если что. 2584444пять

[Nightmarе]

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

[transserg]

Nightmarе
получает серийник флешки =) (физический а не тома)
писал на основе примера (http://rouse.drkb.ru/files/saferemove.zip)

unit FlashSerial;
interface
uses
Windows,StringTools;


{$ALIGN 8}

const
DeviceMask = '%c:';
VolumeMask = '\\.\' + DeviceMask;

setupapi = 'SetupApi.dll';
cfgmgr = 'cfgmgr32.dll';

// Константы и типы из winioctl.h

const
FILE_DEVICE_CONTROLLER = $00000004;
FILE_DEVICE_FILE_SYSTEM = $00000009;
FILE_DEVICE_MASS_STORAGE = $0000002D;

METHOD_BUFFERED = $00000000;
FILE_ANY_ACCESS = $00000000;
FILE_READ_ACCESS = $00000001;
FILE_WRITE_ACCESS = $00000002;

IOCTL_STORAGE_BASE = FILE_DEVICE_MASS_STORAGE;
IOCTL_SCSI_BASE = FILE_DEVICE_CONTROLLER;

FSCTL_LOCK_VOLUME = (FILE_DEVICE_FILE_SYSTEM shl 16) or
(FILE_ANY_ACCESS shl 14) or ($6 shl 2) or METHOD_BUFFERED;

FSCTL_DISMOUNT_VOLUME = (FILE_DEVICE_FILE_SYSTEM shl 16) or
(FILE_ANY_ACCESS shl 14) or ($8 shl 2) or METHOD_BUFFERED;

IOCTL_STORAGE_MEDIA_REMOVAL = (IOCTL_STORAGE_BASE shl 16) or
(FILE_READ_ACCESS shl 14) or ($0201 shl 2) or METHOD_BUFFERED;

IOCTL_STORAGE_EJECT_MEDIA = (IOCTL_STORAGE_BASE shl 16) or
(FILE_READ_ACCESS shl 14) or ($0202 shl 2) or METHOD_BUFFERED;

IOCTL_STORAGE_GET_DEVICE_NUMBER = (IOCTL_STORAGE_BASE shl 16) or
(FILE_ANY_ACCESS shl 14) or ($0420 shl 2) or METHOD_BUFFERED;

IOCTL_SCSI_PASS_THROUGH = (IOCTL_SCSI_BASE shl 16) or
((FILE_WRITE_ACCESS or FILE_READ_ACCESS) shl 14) or
($0401 shl 2) or METHOD_BUFFERED;

GUID_DEVINTERFACE_DISK: TGUID = (
D1:$53f56307; D2:$b6bf; D3:$11d0; D4:($94, $f2, $00, $a0, $c9, $1e, $fb, $8b));

type
DEVICE_TYPE = DWORD;

PStorageDeviceNumber = ^TStorageDeviceNumber;
TStorageDeviceNumber = packed record
DeviceType: DEVICE_TYPE;
DeviceNumber: DWORD;
PartitionNumber: DWORD;
end;

// Константы и типы из setupapi.h
const
ANYSIZE_ARRAY = 1024;

DIGCF_PRESENT = $00000002;
DIGCF_DEVICEINTERFACE = $00000010;

type
HDEVINFO = THandle;

PSPDevInfoData = ^TSPDevInfoData;
SP_DEVINFO_DATA = packed record
cbSize: DWORD;
ClassGuid: TGUID;
DevInst: DWORD; // DEVINST handle
Reserved: ULONG_PTR;
end;
TSPDevInfoData = SP_DEVINFO_DATA;

PSPDeviceInterfaceData = ^TSPDeviceInterfaceData;
SP_DEVICE_INTERFACE_DATA = packed record
cbSize: DWORD;
InterfaceClassGuid: TGUID;
Flags: DWORD;
Reserved: ULONG_PTR;
end;
TSPDeviceInterfaceData = SP_DEVICE_INTERFACE_DATA;

PSPDeviceInterfaceDetailDataA = ^TSPDeviceInterfaceDetailDataA;
PSPDeviceInterfaceDetailData = PSPDeviceInterfaceDetailDataA;
SP_DEVICE_INTERFACE_DETAIL_DATA_A = packed record
cbSize: DWORD;
DevicePath: array [0..ANYSIZE_ARRAY - 1] of AnsiChar;
end;
TSPDeviceInterfaceDetailDataA = SP_DEVICE_INTERFACE_DETAIL_DATA_A;
TSPDeviceInterfaceDetailData = TSPDeviceInterfaceDetailDataA;

function SetupDiGetClassDevsA(ClassGuid: PGUID; const Enumerator: PAnsiChar;
hwndParent: HWND; Flags: DWORD): HDEVINFO; stdcall; external setupapi;

function SetupDiDestroyDeviceInfoList(
DeviceInfoSet: HDEVINFO): LongBool; stdcall; external setupapi;

function SetupDiEnumDeviceInterfaces(DeviceInfoSet: HDEVINFO;
DeviceInfoData: PSPDevInfoData; const InterfaceClassGuid: TGUID;
MemberIndex: DWORD; var DeviceInterfaceData: TSPDeviceInterfaceData):
LongBool; stdcall; external setupapi;

function SetupDiGetDeviceInterfaceDetailA(DeviceInfoSet: HDEVINFO;
DeviceInterfaceData: PSPDeviceInterfaceData;
DeviceInterfaceDetailData: PSPDeviceInterfaceDetailDataA;
DeviceInterfaceDetailDataSize: DWORD; var RequiredSize: DWORD;
Device: PSPDevInfoData): LongBool; stdcall; external setupapi;

// Константы и типы из cfgmgr32.h

const
CR_SUCCESS = 0;

PNP_VetoTypeUnknown = 0;
PNP_VetoLegacyDevice = 1;
PNP_VetoPendingClose = 2;
PNP_VetoWindowsApp = 3;
PNP_VetoWindowsService = 4;
PNP_VetoOutstandingOpen = 5;
PNP_VetoDevice = 6;
PNP_VetoDriver = 7;
PNP_VetoIllegalDeviceRequest = 8;
PNP_VetoInsufficientPower = 9;
PNP_VetoNonDisableable = 10;
PNP_VetoLegacyDriver = 11;
PNP_VetoInsufficientRights = 12;
type
DEVINST = DWORD;
CONFIGRET = DWORD;

PPNP_VETO_TYPE = ^PNP_VETO_TYPE;
PNP_VETO_TYPE = DWORD;

function CM_Get_Parent(var dnDevInstParent: DEVINST;
dnDevInst: DEVINST; ulFlags: ULONG): CONFIGRET; stdcall;
external cfgmgr;

function CM_Request_Device_EjectA(dnDevInst: DEVINST;
pVetoType: PPNP_VETO_TYPE; pszVetoName: PWideChar;
ulNameLength: ULONG; ulFlags: ULONG): CONFIGRET; stdcall;
external setupapi;
{ CMAPI CONFIGRET WINAPI
CM_Get_Device_ID_Size(
OUT PULONG pulLen,
IN DEVINST dnDevInst,
IN ULONG ulFlags
);}
function CM_Get_Device_ID_Size(pulLen:PULONG;dnDevInst: DEVINST;ulFlags: ULONG): CONFIGRET; stdcall;
external setupapi;
{CMAPI CONFIGRET WINAPI
CM_Get_Device_ID(
IN DEVINST dnDevInst,
OUT PTCHAR Buffer,
IN ULONG BufferLen,
IN ULONG ulFlags
);
}
function CM_Get_Device_IDA(dnDevInst: DEVINST;Buffer:PChar;BufferLen:ULONG;ulFlags: ULONG): CONFIGRET; stdcall;
external setupapi;
// Константы и типы из ntddscsi.h

const
SCSI_IOCTL_DATA_IN = 1;
SCSIOP_MECHANISM_STATUS = $BD;

type
USHORT = Word;

PSCSI_PASS_THROUGH_DIRECT = ^SCSI_PASS_THROUGH_DIRECT;
_SCSI_PASS_THROUGH_DIRECT = {packed} record
Length: USHORT;
ScsiStatus: UCHAR;
PathId: UCHAR;
TargetId: UCHAR;
Lun: UCHAR;
CdbLength: UCHAR;
SenseInfoLength: UCHAR;
DataIn: UCHAR;
DataTransferLength: ULONG;
TimeOutValue: ULONG;
DataBuffer: ULONG;
SenseInfoOffset: ULONG;
Cdb: array [0..15] of UCHAR;
end;
SCSI_PASS_THROUGH_DIRECT = _SCSI_PASS_THROUGH_DIRECT;

TSCSIPassThroughDirectBuffer = record
Header: SCSI_PASS_THROUGH_DIRECT;
SenseBuffer: array [0..31] of UCHAR;
DataBuffer: array [0..191] of UCHAR;
end;

function GetFlashSerial(const Value: Char): PChar;
function GetFlashS(const Dr:Char):PChar;
implementation

function GetPath(Path:PChar):PChar;
var
I: Integer;
temp:PChar;
begin
GetMem(temp,MAX_PATH);
for I := lstrlen(path) downto 0 do
if Path[i]<>'\' then
temp:=PChar(path[i]+temp)
else
Break;
Result:=temp;
end;

function GetFlashS(const Dr:Char):PChar;
var
temp:PChar;
begin
temp:=GetFlashSerial(Dr);
Result:=GetPath(temp);
end;

function GetFlashSerial(const Value: Char): PChar;
var
hFile, hDevInfo, hDrive, hDevInstance: THandle;
sdn: TStorageDeviceNumber;
dwDeviceNumber, dwBytesReturned, dwSize: DWORD;
FlashGuid: TGUID;
I: Integer;
DeviceInfoData: TSPDevInfoData;
DeviceInterfaceData: TSPDeviceInterfaceData;
DeviceInterfaceDetailData: TSPDeviceInterfaceDetailData;
Size:DWORD;
Buf:array[0..MAX_PATH] of char;
BufD:PChar;
begin
Result := '';
hDevInstance := INVALID_HANDLE_VALUE;

// Открываем том
GetMem(BufD,MAX_PATH);
wsprintf(BufD,VolumeMask,Value);
hFile := CreateFile(BufD, 0,FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
if hFile = INVALID_HANDLE_VALUE then
begin
Exit;
end;
try
// Получаем номер устройства в системе
if not DeviceIoControl(hFile,IOCTL_STORAGE_GET_DEVICE_NUM BER, nil, 0, @sdn,SizeOf(TStorageDeviceNumber), dwBytesReturned, nil) then
begin
Exit;
end;

dwDeviceNumber := sdn.DeviceNumber;
FlashGuid := GUID_DEVINTERFACE_DISK;
// Подготавливаем список устройств в системе, для поиска хэндла устройства
hDevInfo := SetupDiGetClassDevsA(@FlashGuid, nil, 0,DIGCF_PRESENT or DIGCF_DEVICEINTERFACE);
if hDevInfo = INVALID_HANDLE_VALUE then
begin
Exit;
end;
try

I := 0;
// Крутим цикл по всем устройствам
DeviceInterfaceData.cbSize := SizeOf(TSPDeviceInterfaceData);
while SetupDiEnumDeviceInterfaces(hDevInfo, nil, FlashGuid, I, DeviceInterfaceData) do
begin

Inc(I);

// Узнаем необходимый размер буффера для получения пути к устройству
SetupDiGetDeviceInterfaceDetailA(hDevInfo, @DeviceInterfaceData,nil, 0, dwSize, nil);
if dwSize = 0 then
begin
Exit;
end;

DeviceInfoData.cbSize := SizeOf(TSPDevInfoData);
// Узкий момент, размер структуры должен быть обьявлен как пятерка.
// Почему? Это не ко мне, а к тем кто это придумал -
// в противном случае вызов SetupDiGetDeviceInterfaceDetailA
// будет не успешен
DeviceInterfaceDetailData.cbSize := 5;
// Получаем путь к устройству
if not SetupDiGetDeviceInterfaceDetailA(hDevInfo, @DeviceInterfaceData,@DeviceInterfaceDetailData, dwSize, dwSize, @DeviceInfoData) then
begin
Exit;
end;
// Открываем устройство
hDrive := CreateFile(PChar(@DeviceInterfaceDetailData.Device Path[0]),0, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
if hFile = INVALID_HANDLE_VALUE then
begin
Exit;
end;
try
// Получаем номер устройства в системе
if not DeviceIoControl(hDrive,IOCTL_STORAGE_GET_DEVICE_NU MBER, nil, 0, @sdn,SizeOf(TStorageDeviceNumber), dwBytesReturned, nil) then
begin
Exit;
end;
// Если данное устройство - наше, запоминаем хэндл
if sdn.DeviceNumber = dwDeviceNumber then
begin
hDevInstance := DeviceInfoData.DevInst;
Break;
end;
finally
CloseHandle(hDrive);
end;
end;
finally
SetupDiDestroyDeviceInfoList(hDevInfo);
end;
finally
CloseHandle(hFile);
end;
// Смотрим - нашелся ли хэндл устройства
if hDevInstance <> INVALID_HANDLE_VALUE then
begin
// Получаем хэндл родителя
CM_Get_Device_ID_Size(@size,hDevInstance,0);
if CM_Get_Device_IDA(hDevInstance,buf,size*2,0)=0 then
Result:=Buf;
end;
end;

end.

[warkk]

Может ли функция возвращать массив? Если может то как?
function mas( ... ):array of integer; не работает.

[090808]

1.Пример куска кода вк при изминения группы.


<script type="text/javascript">
onDomReady(function() {
new Checkbox(ge('show_wall'), {
width: 266,
label: 'Стена включена',
checked: 1
});


Нужно что-бы значение "checked: 1" стало "checked: 0"
Нужно сделать замену значения именно в TWebBrowser!

----------------------
2.Как загрузить фото В вк с помощью TWebBrowser (например по кнопке)...

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

[RumShun]

warkk
оформляй массив как тип
type
massiv=array of integer;
потом функцию определяешь
function mas( ... ):massiv;

[RAINUR2]

Так:)как на делфи вывести ошибку...Вроде бы showmessage...Пример нужен

[fenixelite]

ну обрабатываешь ошибку, и если надо то выводишь через showmessage('string'); или через MessageBox(параметры сам поищи)

[RAINUR2]

Ой. извините, в реале чет тупанул:)

[RAINUR2]

Как еще можно убрать пробелы???ункция какая???Хорошо бы что бы полностью все пробелы убрал

[RAINUR2]

Так же у меня есть форма для где я рисую, как его очистить

[fenixelite]

Если графика через canvas то читай тут http://base.vingrad.ru/view/1532-Kak-ochistit-canvas. Да и вообще гугл юзай ))

[Nightmarе]

Как сконвертировать String в Char ?

var
c:char;
s:string;
begin
s=c;

хз чё и как

[h(f)ucker]

c := s[номер символа]

UPD: *c := s[1];

[Nightmarе]

c := s[номер символа]
var
c:char;
s:string;
begin
c:=S[0];
тоже облом (

[transserg]

var
c:char;
s:string;
begin
c:=S[0];
тоже облом (
Nightmarе строка начинает с 1го символа
c:=S[1];

[Soherox]

var
c:char;
s:string;
begin
c:=S[0];
тоже облом (

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

[[stranger]]

в нулевой ячейке хранится длина строки (очень полезная информация, на будущее), поэтому облом, потому что ты строковой переменной присваиваешь число.
[Error] Unit1.pas(33): Element 0 inaccessible - use 'Length' or 'SetLength'
^_^


PS: каким образом можно определить правильность/неправильность пароля NT юзера?

[slesh]

2 [stranger] поищи на форуме. Уже обсуждалось. Там есть апишка по которой можно определить существует ли пользователь с заданным именем и паролем или нет.
Ну или попробовать временно зайти в пользовательское пространство того пользователя, т.е. есть апишка которой даешь имя пользователя и пароль и после её выполнения ты попадаешь в его пространство (если пас правильный), потом можно выйти из него. Некий аналог временного получения других прав

[[stranger]]

2 [stranger] поищи на форуме. Уже обсуждалось. Там есть апишка по которой можно определить существует ли пользователь с заданным именем и паролем или нет.
Ну или попробовать временно зайти в пользовательское пространство того пользователя, т.е. есть апишка которой даешь имя пользователя и пароль и после её выполнения ты попадаешь в его пространство (если пас правильный), потом можно выйти из него. Некий аналог временного получения других прав
спасибо, нашел (http://forum.antichat.ru/threadedpost298261.html)! до этого гуглил, но безрезультатно.. а целенаправленно по ачату помогло.. :)

[ZARO]

'][Error] Unit1.pas(33): Element 0 inaccessible - use 'Length' or 'SetLength'
^_^


PS: каким образом можно определить правильность/неправильность пароля NT юзера?

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

[090808]

Как с помощью delphi залить фото вк?
Хотябы через webbrowser

[denjf]

Как сконвертировать String в Char ?

var
c:char;
s:string;
begin
s=c;

хз чё и как

c:=Pchar(s);

[НTL]

Как с помощью delphi залить фото вк?
Хотябы через webbrowser

как я понял тебе надо передать файл
Вот пример на Indy: http://antigate.com/delphi.zip (Передача картинки на антикапчу)
А если надо на сокетах, то открывай файл и передавай его в мультипосте

[NTFF]

Вот ссылка на то что должно получится http://xmages.net/upload/1496d668.jpg
http://xmages.net/upload/151f94b2.png


{Programm for y(x)=sgrs a*x+b.}
program grafic;
uses crt,graph;
var
grminx,grminy,
grmaxx,grmaxy : integer;
a, b,
stepx,
minx,miny,
maxx,maxy : real;
flag : boolean;
punkt : integer;
s : string;
ercode : integer;


function pow(x,p:real):real;
begin
pow:=exp(ln(x)*p);
end;


function log10(x:real):real;
begin
log10:=ln(x)/ln(10);
end;


function grinit:boolean;
var
grdriver,
grmode,
ercode :integer;
begin
grinit := True;
grdriver:= Detect;
initgraph(grdriver,grmode,'C:\lang\bp\BGI');
ercode:=graphresult;
if ercode<>grok then
begin
writeln('error graphic:',grapherrormsg(ercode));
writeln('programm is stopped. ');
grinit := False;
end;
end;


function getgrx(x:real):integer;
begin
getgrx:=round((grmaxx-grminx)/(maxx-minx)*(x-minx))+grminx;
end;



function getgry(y:real):integer;
begin
getgry:=round((grmaxy-grminy)/(maxy-miny)*(y-miny))+grminy;
end;


function f(a,b,x:real):real;
begin
f:=sqrt(a*x+b);
end;

procedure GetMaxMinY(var miny : real; var maxy : real);
var
x,y : real;
begin

miny := f(a,b,minx);
maxy := f(a,b,minx);
x := minx+stepx;
repeat
y:=f(a,b,x);
if y<miny then miny:=y;
if y>maxy then maxy:=y;
x:=x+stepx;
until x>maxx;
end;


procedure FindXYAxes(var x : integer; var y:integer);
begin

if ((getgrx(0)>=grminx) and (getgrx(0)<=grmaxx)) then
x := getgrx(0)
else
x := grminx;


if ((getgry(0)<=grminy) and (getgry(0)>=grmaxy)) then
y := getgry(0)
else
y := grminy;
end;


procedure DrawMesh;
var
labelsx,labelsy,
blockx,blocky,
tens : real;
grx,gry : integer;
s : string;
x,y : real;
axisx,axisy : integer;
begin

setcolor(lightgreen);
rectangle(grminx,grminy,grmaxx,grmaxy);
rectangle(grminx-1,grminy-1,grmaxx+1,grmaxy+1);

labelsx:=15;
labelsy:=15;


blockx:=(maxx-minx)/labelsx;

tens:=pow(10,round(log10(blockx)));
blockx:=int(blockx/tens+1)*tens;


blocky:=(maxy-miny)/labelsy;

tens:=pow(10,round(log10(blocky)));
blocky:=int(blocky/tens+1)*tens;


settextstyle(SmallFont,HorizDir,2);


FindXYAxes(axisx,axisy);


x:=int(minx/blockx)*blockx;

repeat

grx:=getgrx(x);

if ((grx>=grminx) and (grx<=grmaxx)) then
begin

setcolor(darkgray);
line(grx,grminy,grx,grmaxy);

setcolor(lightgreen);
line(grx,axisy-2,grx,axisy+2);

setcolor(yellow);
str(x:5:2,s);
outtextxy(grx+2,axisy+2,s);
end;
x:=x+blockx;
until x>maxx;


y:=int(miny/blocky)*blocky;




repeat
gry:=getgry(y);


if ((gry<=grminy) and (grx>=grmaxy)) then
begin

setcolor(darkgray);
line(grminx,gry,grmaxx,gry);

setcolor(lightgreen);
line(axisx-2,gry,axisx+2,gry);


setcolor(yellow);
str(y:5:2,s);
outtextxy(axisx+2,gry+2,s);
end;
y:=y+blocky;
until y>maxy;

end;

procedure DrawAxes;
var
s : string;
axisx, axisy : integer;
begin

FindXYAxes(axisx,axisy);

setfillstyle(0,0);

bar(getgrx(0)+1,getgry(0)+1,getgrx(0)+40,getgry(0) +15);
outtextxy(getgrx(0)+4,getgry(0)+2,'0');


setcolor(white);
line(getgrx(minx)-20,axisy,getgrx(maxx)+20,axisy);


moveto(getgrx(maxx)+20,axisy);
linerel(-10,2); linerel(3,-2); linerel(-3,-2); linerel(10,2);


outtextxy(getgrx(maxx)+15,axisy-10,'x');


line(axisx,getgry(miny)+20,axisx,getgry(maxy)-20);


moveto(axisx,getgry(maxy)-20);
linerel(2,10); linerel(-2,-3); linerel(-2,3); linerel(2,-10);

outtextxy(axisx-15,getgry(maxy)-10,'y');

str(a:4:2,s);
s := ' y(x)='+s+'*sin(x)) - sinusoid';
outtextxy(GetMaxX div 2 - 100 ,GetMaxY-25,s);
end;

procedure DrawGraphic;
var
first : boolean;
grx,gry : integer;
x,y : real;
begin

setcolor(LightBlue);
first:=true;
x:=minx;

repeat
y:=f(a,b,x);

grx:=getgrx(x);
gry:=getgry(y);
if first then
begin
moveto(grx,gry);
putpixel(grx,gry,getcolor);
first:=false;
end
else lineto(grx,gry);
x:=x+stepx;
until x>maxx;
end;

BEGIN
flag := false;
repeat
clrscr;
writeln(' --== MENU ==--');
writeln('1. Input parameter function');
writeln('2. Draw graph function');
writeln('3. Exit');
writeln;
writeln('Choose point menu -> ');
readln(punkt);
case punkt of

1:begin
clrscr;
repeat
repeat
writeln('Input min value x (radian) -> ');
readln(s);
val(s,minx,ercode);
if (ercode <> 0) then
writeln('Error min value x!');
until (ercode=0);
repeat
writeln('Input max value x (radian) -> ');
readln(s);
val(s,maxx,ercode);
if (ercode <> 0) then
writeln('Error max value x !');
until (ercode=0);
if (minx>=maxx) then
writeln('Min value x must be smaller max!');
until (minx<maxx);


repeat
writeln('Input value a -> ');
readln(s);
val(s,a,ercode);
if (ercode <> 0) then
writeln('Error value a!');
until (ercode=0);
flag := true;

repeat
writeln('Input value b -> ');
readln(s);
val(s,a,ercode);
if (ercode <> 0) then
writeln('Error value b!');
until (ercode=0);
flag := true;
end;


2: begin

if (flag) then
begin
if (grinit) then
begin
grminx:=48;
grmaxx:=getmaxx-48;
grminy:=getmaxy-48;
grmaxy:=24;
stepx:=(maxx-minx)/150;
GetMaxMinY(miny,maxy);
DrawMesh;
DrawAxes;
DrawGraphic;
readkey;
closegraph;
end
end
else
begin
writeln('You need at the fist choose point 1 for value function!');
readkey;
end;
end;
end;
until (punkt=3);
END.

[qwert135]

У меня такой вопрос.Как в паскале записать двумерный массив в текстовый файл так,чтобы в файле этот массив отображался как таблица,а не как строка из чисел

[slesh]

ну так ставь пробелы(или еще лучше табуляторы) и переходы на новую строки

[TrueBit]

Как узнать из какой папки открыта программа?

[transserg]

TrueBit

DWORD WINAPI GetModuleFileName(
__in_opt HMODULE hModule,
__out LPTSTR lpFilename,
__in DWORD nSize
);

С помощью GetModuleFileName получаешь путь до своей проги!
ссылка на описание (http://msdn.microsoft.com/en-us/library/ms683197(VS.85).aspx)

[patcher]

Как узнать из какой папки открыта программа?
в Делфи я делаю это обычно так:

extractfilepath(Application.Exename);

[1n0y]

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

как проще всего это реализовать на делфи? натолкните на верный путь :)

[presidentua]

Волей судьбы вернуло меня с Питоновского поля программирования к Делфи )

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

Перепробовал кучу из них, но что-то то одна работает с огронмыми утечками, то с глюками какими-то. Так и не смог найти ничего полезно(.

[RumShun]

1n0y я лично предпочитаю использовать ADO, когда по быстрому надо )). если не нагуглишь или вопросы будут стучи в аську помогу.

[1n0y]

1n0y я лично предпочитаю использовать ADO, когда по быстрому надо )). если не нагуглишь или вопросы будут стучи в аську помогу.

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

[RumShun]

1n0y я вот что нагуглил
пример: _http://svdpro.info/page.php?id=18
компоненты: _http://delphi.about.com/od/mysql/tp/aatpmysql.htm
я так понял после прочитки лучше всего из бесплатных Zeos Library
и тебе знание sql скорее всего понадобиться

[RumShun]

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

[Qb1024]

Как прога на делфи может узнать, что комп вышел из режима гибернации или сна???

[Berman]

Этот код поможет узнать находится ли компьютер в процессе гибернации.
function HibernateAllowed: Boolean;
type
TIsPwrHibernateAllowed = function: Boolean;
stdcall;
var
hPowrprof: HMODULE;
IsPwrHibernateAllowed: TIsPwrHibernateAllowed;
begin
Result := False;
if IsNT4Or95 then Exit;
hPowrprof := LoadLibrary('powrprof.dll');
if hPowrprof <> 0 then
begin
try
@IsPwrHibernateAllowed := GetProcAddress(hPowrprof, 'IsPwrHibernateAllowed');
if @IsPwrHibernateAllowed <> nil then
begin
Result := IsPwrHibernateAllowed;
end;
finally
FreeLibrary(hPowrprof);
end;
end;
end;




Этот код поможет узнать находится ли компьютер в процессе сна.
function SuspendAllowed: Boolean;
type
TIsPwrSuspendAllowed = function: Boolean;
stdcall;
var
hPowrprof: HMODULE;
IsPwrSuspendAllowed: TIsPwrSuspendAllowed;
begin
Result := False;
hPowrprof := LoadLibrary('powrprof.dll');
if hPowrprof <> 0 then
begin
try
@IsPwrSuspendAllowed := GetProcAddress(hPowrprof, 'IsPwrSuspendAllowed');
if @IsPwrSuspendAllowed <> nil then
begin
Result := IsPwrSuspendAllowed;
end;
finally
FreeLibrary(hPowrprof);
end;
end;
end;

[Qb1024]

Спасибо за код. И такой вопрос: эта функция вернет истину когда сам комп спит??? Проц то в это время не работает...

[[stranger]]

видимо этот код проверяет возможность hibernate вообще..

[Qb1024]

Хм, если это так, то это не совсем то. На моей семёрке он явно есть.

[Qb1024]

Да, точно, этот код проверяет доступность соответствующих режимов на компе. Вопрос открыт.

[xafon]

как узнать содержимое файла, который есть на сервере (http://site/file.dat). и при нахождении строчки (например: mesage hello) вывести сообщение hello?

[Berman]

возможно ошибаюсь но примерно так
idhttp1.get('http://site/file.dat');
это вывести в мемо а потом процедурой search найти нужное слово

[xafon]

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

[TrueBit]

как узнать содержимое файла, который есть на сервере (http://site/file.dat). и при нахождении строчки (например: mesage hello) вывести сообщение hello?
var
s: string;
begin
s:=idhttp1.get('http://site/file.dat');
if pos('mesage hello', s)<>0 then
showmessage('hello');
end;
примерно так

[wolmer]

var
s: string;
begin
s:=idhttp1.get('http://site/file.dat');
if pos('mesage hello', s)<>0 then
showmessage('hello');
end;
примерно так
Если же быть совсем точным то (если вместо hello -> будет не предсказуемое слово)(не сочти меня за "умника" :D ):
var
s: string;
begin
s:=idhttp1.get('http://site/file.dat');
//Допустим будет в s слово: message_hello_:)
//Единственное что тут могут регистры мешать (но это дело поправимое :) )
if pos('message', s)<>0 then
begin
showmessage(copy(s, pos('message_', s)+length('message_'),
length(s)-length('message ')-3));
end;
end;
Второй вариант: использовать регулярку

[Андрей021]

Этим кодом я записываю строковой параметр. что сдесь поправить, что бы записывался двоичный параметр REG_BINARY "Timeout"=hex:0a,00,00,00?

program Project1;

uses
registry,
SysUtils;

var
reg:tregistry;

const
HKEY_LOCAL_MACHINE = $80000002;

begin
reg:=tregistry.create;
reg.rootkey:=HKEY_LOCAL_MACHINE;
if reg.openkey('SYSTEM\CurrentControlSet\Services\Net logon, true) then
begin
reg.WriteString('Timeout', '0a,00,00,00');
reg.closekey;
end;

reg.free;
end.

[ErrorNeo]

шлю запрос:

sendbuff := 'GET '+request+' HTTP/1.1'+ #13#10 +
'Host: domain.com'+ #13#10 +
'User-Agent: Mozilla/5.0 (Windows NT 5.1; ru; rv:1.9.0.17)'+ #13#10 +
'Accept: text/html'+ #13#10 +
'Accept-Language: ru,en-us;q=0.7,en;q=0.3'+ #13#10 +
// 'Accept-Encoding: gzip,deflate'+ #13#10 +
'Accept-Charset: windows-1251,utf-8;q=0.7,*;q=0.7'+ #13#10 +
'Keep-Alive: 300'+ #13#10 +
если раскоменчу 'Accept-Encoding: gzip,deflate'+ #13#10 +- не могу прочесть результат:( В смысле, не могу перевести его в "читабальный" вид - а мне к результату надо применять ф-ции pos и copy.
Тем не менее использовать компрессию все же хотелось бы, т.к. скорость работы программы упирается в нехватку траффика.

Кто подскажет, как проще реализовать де-шифровку gzip ?
(видел в гугли какие-то замороченно-трехэтажные методы - не верю, что это настолько сложно)

за помощь буду благодарен!

[alexey-m]

Этим кодом я записываю строковой параметр. что сдесь поправить, что бы записывался двоичный параметр REG_BINARY "Timeout"=hex:0a,00,00,00?

procedure RegWrite;
var
reg: TRegistry;
Bin: array[0..10] of Byte;
I: Integer;
begin
for i:= 0 to High(Bin) do Bin[i]:= i;

reg:= TRegistry.Create(KEY_ALL_ACCESS);
with Reg do
try
RootKey:= HKEY_CURRENT_USER;
OpenKey('Software\my_sub_key', True);
WriteInteger('Integer', I);
WriteDate('Date', Now);
WriteBinaryData('BinData', Bin, SizeOf(Bin));
WriteString('String', 'String');
WriteBool('Bool',True);
Reg.WriteFloat('Float',2.366);
CloseKey;
finally
Free;
end;
end;

[RedFern.89]

шлю запрос:

sendbuff := 'GET '+request+' HTTP/1.1'+ #13#10 +
'Host: domain.com'+ #13#10 +
'User-Agent: Mozilla/5.0 (Windows NT 5.1; ru; rv:1.9.0.17)'+ #13#10 +
'Accept: text/html'+ #13#10 +
'Accept-Language: ru,en-us;q=0.7,en;q=0.3'+ #13#10 +
// 'Accept-Encoding: gzip,deflate'+ #13#10 +
'Accept-Charset: windows-1251,utf-8;q=0.7,*;q=0.7'+ #13#10 +
'Keep-Alive: 300'+ #13#10 +
если раскоменчу - не могу прочесть результат:( В смысле, не могу перевести его в "читабальный" вид - а мне к результату надо применять ф-ции pos и copy.
Тем не менее использовать компрессию все же хотелось бы, т.к. скорость работы программы упирается в нехватку траффика.

Кто подскажет, как проще реализовать де-шифровку gzip ?
(видел в гугли какие-то замороченно-трехэтажные методы - не верю, что это настолько сложно)

за помощь буду благодарен!



gzip и deflite - это параметры компрессии. Т.е. ты говоришь серверу прислать тебе сжатый текст..

[GhostOnline]

ЕррорНео я бы тебе посоветовал использовать инди где это решается в пару строк кода,
но я уже в другой теме прочитал что ты не любишь её (велосипедо-строительство рулед)

Хотя, мб есть возможность прикрутить всего один класс TIdCompressorZLib, но его метод имеет вид:
procedure DecompressHTTPDeflate(
AInStream: TIdStream,
AOutStream: TIdStream
);
Т.е. в любом случае надо конвертировать в TIdStream

[ErrorNeo]

gzip и deflite - это параметры компрессии. Т.е. ты говоришь серверу прислать тебе сжатый текст..
правда? Оо.

ЕррорНео я бы тебе посоветовал использовать инди где это решается в пару строк кода,
но я уже в другой теме прочитал что ты не любишь её (велосипедо-строительство рулед)я не люблю инди потому что он глючен + не позволяет развивать больших скоростей. (а многие мои прграммы за счет Вин-Апи обрабатывают по 10+- тысяч запросов\мин)
Но за совет тем не менее благодарю. Может быть в этой конерктной программе, где у меня все упирается в траффик - и правда эффективнее будет заюзать инди.

Хотя, конечно, было бы прикольнее просто каким-то образом декодировать gzip=\

спс.

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

[GhostOnline]

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

[RedFern.89]

в инди все просто сделанно, и там ты можешь "Декомпресировать" текст, который тебе прислал сервер. В принципе это экономия трафика))

[RumShun]

Ты как специализирующийся на винсок, можешь сказать сколько % выигрыша в скорости дают сокеты перед инди? это от задачи зависит, допустим тебе несколько сот(тысяч) потоков надо создать и чтото в них передать по сети, если ты сделаешь это в инди то прога боюсь не только медленнее это делать будет но и вообще комп повесит.

[RedFern.89]

везде свои подюсы и минусы)) все зависит от цели)

[ErrorNeo]

Ты как специализирующийся на винсок, можешь сказать сколько % выигрыша в скорости дают сокеты перед инди?
зависит от приложения. Если потоков мало - врятли выиграш будет заметен, а в многопоточных приложениях (1000+ потоков) выигрыш - десятки процентов.

[slesh]

2 ErrorNeo 1000+ потоков 0 выигрыш будет = бесконечности потому что деление на 0 даст ошибку )) т.к. в 1000 потоков инди загнется все со всей прогой и половиной винды )

[REC0N]

Дана матрица NxN.
Помогите вывести номер строки с минимальным число элементов что равны заданному (заданое число вводит пользователь)
Итак, у меня выводит n строк и количество элементов и напротив каждой строки, как вывести лишь минимальную строку?
Вот что наработал:

program matryca;
uses crt;
const nmax=1000;
label 25;

var Matr:array[1..nmax,1..nmax] of integer;
Vec:array[1..nmax] of integer;
n,m,i,j,k,l,min : integer;

begin
25:
write ('Введите количество строк в матрице:');
readln (m);
write ('Введите количество столбцов в матрице:');
readln (n);
if m<>n then begin writeln('Матрица должна быть квадратная! ! !');goto 25; end;


// Ввод матрицы

writeln(' ');
writeln(' -------------------- ');
writeln(' Ввод матрицы ');
writeln(' -------------------- ');
writeln(' ');

for i:=1 to n do
for j:=1 to m do begin

write ('Введите элемент матрицы A(',i,';',j,'):');
readln (Matr[i,j]);
end;

// Вывод матрицы

for i:=1 to n do begin
write('(',i,'-я строка) ');
for j:=1 to m do
write(Matr[i,j],' ');
writeln;
end;

// Введення числа


write('Введите число: ');
read(k);

for i:=1 to n do begin vec[i]:=0;
for j:=1 to m do begin

if k=matr[i,j] then vec[i]:=vec[i]+1
end;


end;

for i:=1 to n do begin
write('Количество введенных пользователем символов в ', i,'-й строчке: ', vec [i]);
writeln;
end;

end.program matryca; uses crt; const nmax=1000; label 25; var Matr:array[1..nmax,1..nmax] of integer; Vec:array[1..nmax] of integer; n,m,i,j,k,l,min : integer; begin 25: write ('Введите количество строк в матрице:'); readln (m); write ('Введите количество столбцов в матрице:'); readln (n); if m<>n then begin writeln('Матрица должна быть квадратная! ! !');goto 25; end; // Ввод матрицы writeln(' '); writeln(' -------------------- '); writeln(' Ввод матрицы '); writeln(' -------------------- '); writeln(' '); for i:=1 to n do for j:=1 to m do begin write ('Введите элемент матрицы A(',i,';',j,'):'); readln (Matr[i,j]); end; // Вывод матрицы for i:=1 to n do begin write('(',i,'-я строка) '); for j:=1 to m do write(Matr[i,j],' '); writeln; end; // Введення числа write('Введите число: '); read(k); for i:=1 to n do begin vec[i]:=0; for j:=1 to m do begin if k=matr[i,j] then vec[i]:=vec[i]+1 end; end; for i:=1 to n do begin write('Количество введенных пользователем символов в ', i,'-й строчке: ', vec [i]); writeln; end; end.

P.S:Делал на PascalABC

[fenixelite]

Ну а что тут сложного? Сравни кол-во повторенией в строках и выведи строку с минимальным количеством.

P.S и вообще ABC - зло :p

[NTFF]

Помогите с лабораторной на списки
Разработать справочник пассажирских поездов с полями: номер поезда, станции отправления и назначения, время в дороге, категория поезду. Реализовать подпрограммы поиска: 1) по станциям отправления и назначения, 2) по категории поезду.

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

program Records;
uses
crt, strings;
const
max = 100; {максимальное допустимое количество записей в массиве}
type
{Тип данных для описания книги}
TBook = record
name : string[40]; {название}
author : string[20]; {автор}
style : string[20]; {жанр}
tom : byte; {количество томов}
year : word; {год выпуска}
end;

{Тип данных "Каталог книг" - массив из 100 книг}
TBooks = array [1..max] of TBook;

{Процедура рисование окна без рамки.
Вх.данные:
(x1,y1) - координаты верхнего левого угла окна,
(x2,y2) - координаты нижнего правого угла окна,
tc - цвет текста,
c - цвет фона окна}
procedure SngWindow(x1,y1,x2,y2,tc,c : byte);
begin
window(x1,y1,x2,y2);
textbackground(c);
textcolor(tc);
clrscr;
end;

{Процедура рисование окна с рамкой шириной в 1 символ.
Вх.данные:
(x1,y1) - координаты верхнего левого угла окна,
(x2,y2) - координаты нижнего правого угла окна,
tc - цвет текста,
c1 - цвет рамки,
c2 - цвет фона окна}
procedure DblWindow(x1,y1,x2,y2,tcolor, c1, c2 : byte);
begin
window(x1,y1,x2,y2);
textbackground(c1);
clrscr;
window(x1+1,y1+1,x2-1,y2-1);
textbackground(c2);
textcolor(tcolor);
clrscr;
end;

{Функция для отображения главного меню и выбора одного из его пунктов.
Функция возвращает значение от 1 до 5.}
function Menu : byte;
var
punkt : byte; {номер выбранного пункта меню}
er : integer; {код ошибки при преобразовании строки в число}
s : string; {строка для проверки вводимого номера пункта меню}
begin
{Закрасить весь экран черным цветом}
SngWindow(1,1,80,25,WHITE,BLACK);
{Нарисовать рабочее окно}
SngWindow(1,6,80,25,WHITE,BLUE);
{цикл выполняется до тех пор, пока пользователь не введет число от 1 до 5}
repeat
{Нарисовать окно для главного меню}
DblWindow(1,1,80,5,YELLOW,MAGENTA,BLUE);
writeln;
write(' 1.Добавить 2.Удалить 3.Печать 4.Поиск 5.Выход');
readln(s); {ввод номера пункта меню}
val(s,punkt,er);
until (er=0) and (punkt>=1) and (punkt<=5);
Menu := punkt; {возврат значения функции}
end;
{Функция для отображения подменю для поиска и выбора одного из его пунктов.
Функция возвращает значение от 1 до 4.}
function SubMenu : byte;
var
punkt : byte; {номер выбранного пункта меню}
er : integer; {код ошибки при преобразовании строки в число}
s : string; {строка для проверки вводимого номера пункта меню}
begin
{Закрасить весь экран черным цветом}
SngWindow(1,1,80,25,WHITE,BLACK);
{Нарисовать рабочее окно}
SngWindow(1,6,80,25,WHITE,BLUE);
{цикл выполняется до тех пор, пока пользователь не введет число от 1 до 4}
repeat
{Нарисовать окно для главного меню}
DblWindow(1,1,80,5,YELLOW,MAGENTA,BLUE);
writeln;
write(' 1.Поиск по названию 2.Поиск по автору 3.Поиск по году 4.Выход');
readln(s); {ввод номера пункта меню}
val(s,punkt,er);
until (er=0) and (punkt>=1) and (punkt<=4);
SubMenu := punkt; {возврат значения функции}
end;

{Процедура добавления книги в каталог книги.
Книга добавляется в конец каталога.
Вх.данные:
mas - каталог книг;
n - количество книг в каталоге;
size - максимальное возможное количество книг в каталоге;
Вых.данные:
если каталог полностью еще не заполнен, то в него будет добавлена
книга и n увеличится на 1, в противном случае - книга не добавляется.
mas - каталог книг;}
procedure AddRecord(var mas : TBooks; var n : byte; size : byte);
var
s : String; {строка для ввода числовых значений}
er : integer; {код ошибки при преобразовании строки в число}
begin
{проверка: есть ли еще место для новой книги в каталоге}
if (n+1 <= size) then
begin
inc(n); {увеличение количества книг в каталоге}
{ввод названия, автора и жанра книги}
write('Название книги =>'); readln(mas[n].name);
write('Автор =>'); readln(mas[n].author);
write('Жанр =>'); readln(mas[n].style);
{ввод количества томов (>0)}
repeat
write('Количество томов =>');
readln(s);
val(s,mas[n].tom,er);
until (er=0) and (mas[n].tom>0);
{ввод года издания (в диапазоне [1900;2008])}
repeat
write('Год издания =>');
readln(s);
val(s,mas[n].year,er);
until (mas[n].year >= 1900) and (mas[n].year<=2008);
writeln('Книга добавлена в каталог!');
end
else writeln('Недостаточно места в каталоге!');
end;

{Процедура печати информации о книге под номером i в каталоге}
procedure PrintRecord(var mas : TBooks; i : integer);
begin
write(i:3);
with mas[i] do
begin
write(name:23); write(author:20);
write(style:10); write(tom:10);
write(year:12);
writeln;
end;
end;

{Процедура печати содержимого всего каталога.
Вх.данные:
mas - каталог книг,
n - количество книг в каталоге}
procedure Print(var mas : TBooks; n : integer);
var
i : integer; {номер книги в каталоге}
begin
writeln('#':3,'Название':23,'Автор':2 0,'Жанр':10,'Тома':10,'Год издания':12);
for i:=1 to n do
PrintRecord(mas,i);
end;

{Процедура удаления книг из каталога под названием bname.
Вх.данные:
mas - каталог книг,
n - количество книг в каталоге,
bname - название книг, которые необходимо удалить из каталога
Вых.данные:
если в каталоге имеются книги под название bname информация о
них будет распечатана и они будут удалены из каталога и
количество книг в каталоге n уменьшиться на количество удаленных книг;
если в каталоне нет книг под заданным названием на экран
не будет выводиться информация о книгах.}
procedure DelRecordByName(var mas : TBooks; var n : byte; bname : string);
var
i,j : integer; {номера книг в каталоге}
begin
writeln('#':3,'Название':23,'Автор':2 0,'Жанр':10,'Тома':10,'Год издания':12);
{цикл для просмотра всех книг каталога}
for i:=1 to n do
begin
with mas[i] do
{книга под номером i имеет название bname,
следовательно ее необходимо удалить из каталога}
if (name = bname) then
begin
PrintRecord(mas,i); {печать информации об удаляемой книге}
{цикл для смещения книг на одну позицию влево для
удаления книги из каталога}
for j:=i+1 to n do
mas[j-1] := mas[j];
{количество книг в каталоге уменьшилось на 1}
dec(n);
end;
end;
end;

{Процедура поиска книг по названию.
Вх.данные:
mas - каталог книг;
n - количество книг в каталоге;
bname - название книги, по которому необходимо осуществлять поиск книг;
Вых.данные: на экране монитора в табличном виде распечатается информация о
книгах с названием bname.}
procedure FindByName(var mas : TBooks; n : integer; bname : string);
var
i : integer; {номер книги}
begin
writeln('#':3,'Название':23,'Автор':2 0,'Жанр':10,'Тома':10,'Год издания':12);
{просмотр всех книг в каталоге}
for i:=1 to n do
with mas[i] do
{название книги совпадает с заданным названием bname}
if name=bname then PrintRecord(mas,i);
end;

{Процедура поиска книг по автору и жанру.
Вх.данные:
mas - каталог книг;
n - количество книг в каталоге;
ba - автор книги;
bst - жанр книги;
Вых.данные: на экране монитора в табличном виде распечатается информация о
книгах, которые написал автор ba в жанре bst.}
procedure FindByAuthor(var mas : TBooks; n : integer; ba, bst : string);
var
i : integer; {номер книги}
begin
writeln('#':3,'Название':23,'Автор':2 0,'Жанр':10,'Тома':10,'Год издания':12);
{просмотр всех книг в каталоге}
for i:=1 to n do
with mas[i] do
{автор книги и жанр совпадают с заданными автором ba и жанром bst}
if (author=ba) and (style=bst) then PrintRecord(mas,i);
end;

{Процедура поиска книг по году издания.
Вх.данные:
mas - каталог книг;
n - количество книг в каталоге;
[a,b] - период издания книг;
Вых.данные: на экране монитора в табличном виде распечатается информация о
книгах, которые были изданы в период годов от а до b.}
procedure FindByYear(var mas : TBooks; n : integer; a, b : word);
var
i : integer; {номер книги}
begin
writeln('#':3,'Название':23,'Автор':2 0,'Жанр':10,'Тома':10,'Год издания':12);
{просмотр всех книг в каталоге}
for i:=1 to n do
with mas[i] do
{год издания книги находиться в диапазоне от а до b}
if (a<=year) and (year<=b) then PrintRecord(mas,i);
end;

var
b : TBooks; {каталог книг}
n : byte; {количество книг в каталоге}
punkt : byte; {номер пункта меню}
subpunkt : byte; {номер подпункта в пункте меню Поиск}
bookname, {название книги}
a, {автор книги}
st : string; {жанр книги}
y1,y2 : word; {диапазон годов издания книг}
s : string; {строка для ввода числовых значений}
er : integer; {код ошибки при переводе строки в число}

begin
n := 0; {в каталоге нет книг}
SngWindow(1,1,80,25,WHITE,BLACK);
repeat
punkt:= Menu; {выбор пункта меню}
case (punkt) of
1:begin {пункт Добавление книги}
SngWindow(1,6,80,25,WHITE,BLUE);
writeln(' ДОБАВЛЕНИЕ КНИГИ В КАТАЛОГ');
AddRecord(b,n,max); {добавление книги в каталог b}
readkey;
end;
2:begin {пункт Удаление книги}
SngWindow(1,6,80,25,WHITE,BLUE);
writeln(' УДАЛЕНИЕ КНИГ ПО НАЗВАНИЮ');
{Задание значения ключа - название книги}
write('Название книги =>');
readln(bookname);
{удаление из каталога книг по названию книги}
DelRecordByName(b,n,bookname);
readkey;
end;
3:begin {печать каталога книг}
SngWindow(1,6,80,25,WHITE,BLUE);
writeln(' КАТАЛОГ КНИГ');
Print(b,n); {печать в табличном виде информации о книгах в каталоге}
readkey;
end;
4:begin {пункт Поиск книг}
repeat
subpunkt := SubMenu; {выбор пункта меню по поиску книг}
case (subpunkt) of
1:begin {пункт Поиск по названию книги}
SngWindow(1,6,80,25,WHITE,BLUE);
writeln(' КНИГИ ПО НАЗВАНИЮ ');
{задание ключа поиска по названию книги}
write('Название книги =>');
readln(bookname);
{поиск книг в каталоге b по названию bookname}
FindByName(b,n,bookname);
readkey;
end;
2:begin {пункт Поиск по автору и жанру}
SngWindow(1,6,80,25,WHITE,BLUE);
writeln(' КНИГИ ПО АВТОРУ И ЖАНРУ');
{задание ключа поиска по автору}
write('Автор книги =>');
readln(a);
{задание ключа поиска по жанру}
write('Жанр книги =>');
readln(st);
{поиск книг в каталоге b по автору и жанру}
FindByAuthor(b,n,a,st);
readkey;
end;
3:begin {поиск по году издания}
SngWindow(1,6,80,25,WHITE,BLUE);
writeln(' КНИГИ ПО ГОДУ ИЗДАНИЯ ');
{цикл задания ключа поиска по году издания}
repeat
{задание ключа поиска - минимальный год}
repeat
write('Минимальный год =>');
readln(s);
val(s,y1,er);
until (er=0) and (y1>=1900); {год издания должен быть >= 1900}
{задание ключа поиска - максимальный год}
repeat
write('Максимальный год =>');
readln(s);
val(s,y2,er);
until (er=0) and (y2<=2008); {год издания должен быть <= 2008}
until (y1<y2);
{поиск книги по году издания [y1,y2] в каталоге b}
FindByYear(b,n,y1,y2);
readkey;
end;
end;
until (subpunkt = 4); {выход из подменю поиска при выборе пункта 4}
end;
end;
until (punkt = 5); {выход из программы при выборе пункта меню 5}
SngWindow(1,1,80,25,WHITE,BLACK);
end.

это написано на паскале что и как сдесь я не знаю нам ток сказали что б было на подобии

[RumShun]

так тебе через записи или через списки надо? это разные вещи(ты через записи сделал).
закинь свой исходник в теги, и я не понял всетаки что тебе надо? код не работает?

[NTFF]

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

Разработать справочник пассажирских поездов с полями: номер поезда, станции отправления и назначения, время в дороге, категория поезду. Реализовать подпрограммы поиска: 1) по станциям отправления и назначения, 2) по категории поезду

[Андрей021]

Как получить путь к файлу в консольном приложении, как в ГУИ Application.ExeName?

[wolmer]

Как получить путь к файлу в консольном приложении, как в ГУИ Application.ExeName?
ParamStr(0)

[kohanov4]

Парни как можно вывести изображение на рабочий стол поверх всех окон с помощью например Delphi (WinAPI)???Очень надо. заранее спасибо

[Tor Bel]

Парни как можно вывести изображение на рабочий стол поверх всех окон с помощью например Delphi (WinAPI)???Очень надо. заранее спасибо
Так поверх всех окон или на рабочий стол?

[xafon]

var
s: string;
begin
s:=idhttp1.get('http://site/file.dat');
//Допустим будет в s слово: message_hello_:)
//Единственное что тут могут регистры мешать (но это дело поправимое :) )
if pos('message', s)<>0 then
begin
showmessage(copy(s, pos('message_', s)+length('message_'),
length(s)-length('message ')-3));
end;
end;

на winsock'e, как это будет выглядеть?

[#Specan]

Господа, я дико извиняюсь, но очень хочу узнать...

Когда работаешь с сокетами в PHP есть замечательная функция feof, которая показывает есть ещё данные в буффере приёма или нет (соответственно false - если данные есть, true - если нет).
Так вот, есть ли аналог этой функции в Delphi применительно к сокетам???

[kohanov4]

Так поверх всех окон или на рабочий стол?
Tor Bel я имел в виду что даже если открыты окна то всё равно рисовалось поверх них.

[angelset95]

нужна прога работающия с баузером, для авто рега адного приложения по базе аккаунтов , для контакта, к каму обратится? с ценой договаримся(+встроеная анти капча)
писать в аську 439-849-667 (с пометкой прога для контакта) по цене договаримся

[RumShun]

[сплошной оффтоп]
NTFF тебе сюда _http://www.forum.antichat.ru/thread122076.html
angelset95 тебе сюда http://www.forum.antichat.ru/forum57.html
Сергеичу привет и респект
[/сплошной оффтоп]

[[stranger]]

чем отличается служба NT (TServiceApplication) от обычного приложения?

[wolmer]

var
s: string;
begin
s:=idhttp1.get('http://site/file.dat');
//Допустим будет в s слово: message_hello_:)
//Единственное что тут могут регистры мешать (но это дело поправимое :) )
if pos('message', s)<>0 then
begin
showmessage(copy(s, pos('message_', s)+length('message_'),
length(s)-length('message ')-3));
end;
end;

на winsock'e, как это будет выглядеть?
Почитай книжку Михаила Фленова под названием "delphi, в шутку и в серьез (что умеют хакеры)", там хорошо расписанно про winsock (завтра обяз. скину тебе в личку пример работы с HTTP на winsock)

[NTFF]

люди помогите с лабой

[transserg]

NTFF а где задание и что за лаба?

[Paranoik]

можно ли залогиневшись через twebbrowser на соцке вконтакте, вставить за место гарффити свою картинку кому либо на стенку.. еслид а, то как? ...именно работая через webbrowser.

[slesh]

Webbrowser предоставляет юзверям доступ ко всему через COM и по этому этому можно загрузить страницу, затем через доступом к нужным элементам задать им значения.

Если дело в графити, то тут дело чуть в другом, потому что там отправка из под флеша идет. И по этому тут WB непоможет.

[fenixelite]

Кто нибудь знает, как решить проблему с русскими символами в Indy 10 ? Вместо них на сервер приходят вопрос. знаки (???? ??)

[GhostOnline]

1. Попробуй обновить индей. Раньше такая же трабла была, поставил 10.5.7 и давно проблем нету.
2. Если не поможет, пробуй явно декодировать специальными функциями, типа Utf8ToAnsi, как-то так называются.

[fenixelite]

Не подкинешь ссылку где обновить можно?

[GhostOnline]

_http://kvendi.pp.ru/?p=66 вот годная статья про это

[fenixelite]

Огромное спасибо. Просто щас для себя пишу IRC клиент, и столкнулся с такой проблемой.

[Скотти]

Есть библиотеки libeay32.dll и libssl32.dll. Как мне их скомпилировать вместе с программой. То есть чтоб в самом ехе файле были эти библиотеки, а не например в папке с ехе'шником. Заранее спасибо.

[fenixelite]

http://acti.easyforum.ru/viewtopic.php?id=21

Попробуй, мб поможет

[НTL]

Есть текст:

имя значение
имя2 значение2
имя3 значение3
имя4 значение4
имя5 значение5
имя6 значение6
Test yes

В таком духе, как это загнать в массив, то что до пробела имя элемента, после, значение?

[fenixelite]

У элемента массива есть имя? Оо Могу предложить сделать либо 2 массива(1-имя, 2-значение), либо двухмерный массив( например [1,1] - имя1, [1,2] -значение1

[НTL]

У элемента массива есть имя? Оо Могу предложить сделать либо 2 массива(1-имя, 2-значение), либо двухмерный массив( например [1,1] - имя1, [1,2] -значение1

Может я что то недопонимаю:
test1[name]:='Бла бла';
Но мне кажется что в [] указывается имя

[fenixelite]

там числовой индекс указывается. test1[1] , test[2] и т.д.. По крайней мере в Delphi так.

[НTL]

там числовой индекс указывается. test1[1] , test[2] и т.д.. По крайней мере в Delphi так.

Жаль, в PHP можно и имя назначить

[GhostOnline]

Не надо 2 массивов если работаешь с текстом. есть варианты проще:
TStringList
Пример кода : Использование строк название-значение var names : TStringList; // Определение нашей переменной списка строк ageStr : String; i : Integer; begin // Определение объекта списка строк, и указание нашей переменной на него names := TStringList.Create; // Теперь добавляем несколько названия в наш список names.CommaText := 'Neil=45, Brian=63, Jim=22'; // И теперь находим возраст Брайена ageStr := names.Values['Brian']; // Показ этого значения ShowMessage('Возраст Brian'а = '+ageStr); // Теперь отображаем все имена и значение возраста for i := 0 to names.Count-1 do begin ShowMessage(names.Names[i]+' - '+names.ValueFromIndex[i]); end; end; Возраст Brian'а 63 Neil - 45 Brian - 63 Jim - 22

Источник: http://delphibasics.ru/TStringList.php
Самое то для таких вещей
И имена можно использовать

[fenixelite]

В общем сделал в 2 массивами, думаю сам разберешься, что к чему. :D
http://slil.ru/28760299

[NTFF]

program Records;
uses
crt, strings;
const
max = 100;
type

Ttrain = record
Otpravlenie : string[40];
Pribitie : string[40];
Category : string[10];
Time : string[10];
Number : string[10];
end;

Ttrains = array [1..max] of Ttrain;


procedure SngWindow(x1,y1,x2,y2,tc,c : byte);
begin
window(x1,y1,x2,y2);
textbackground(c); textcolor(tc);
clrscr;
end;


procedure DblWindow(x1,y1,x2,y2,tcolor, c1, c2 : byte);
begin
window(x1,y1,x2,y2);
textbackground(c1);
clrscr;
window(x1+1,y1+1,x2-1,y2-1);
textbackground(c2);
textcolor(tcolor);
clrscr;
end;


function Menu : byte;
var
punkt : byte;
er : integer;
s : string;
begin

SngWindow(1,1,80,25,WHITE,BLACK);

SngWindow(1,6,80,25,WHITE,BLUE);

repeat

DblWindow(1,1,80,5,YELLOW,MAGENTA,BLUE);
writeln;
write(' 1.ADD 2.DELETE 3.PRINT 4.SEARCH 5.EXIT');
readln(s);
val(s,punkt,er);
until (er=0) and (punkt>=1) and (punkt<=5);
Menu := punkt;
end;


function SubMenu : byte;
var
punkt : byte;
er : integer;
s : string;
begin

SngWindow(1,1,80,25,WHITE,BLACK);

SngWindow(1,6,80,25,WHITE,BLUE);

repeat
{Нарисовать окно для главного меню}
DblWindow(1,1,80,5,YELLOW,MAGENTA,BLUE);
writeln;
write(' 1.Otpravlenie 2.Pribitie 3.Number 4.Exit');
readln(s); {ввод номера пункта меню}
val(s,punkt,er);
until (er=0) and (punkt>=1) and (punkt<=4);
SubMenu := punkt;
end;


procedure AddRecord(var mas : Ttrains; var n : byte; size : byte);
var
s : String;
er : integer;
begin

if (n+1 <= size) then
begin
inc(n);

write('Otpravlenie =>'); readln(mas[n].Otpravlenie);
write('Pribitie =>'); readln(mas[n].Pribitie);
write('Category =>'); readln(mas[n].Category);
write('Time =>'); readln(mas[n].Time);
write('Number =>'); readln(mas[n].number);

writeln('Книга добавлена в каталог!');
end
else writeln('Недостаточно места в каталоге!');
end;


procedure PrintRecord(var mas : Ttrains; i : integer);
begin
write(i:3);
with mas[i] do
begin
write(Otpravlenie:23); write(Pribitie:20);
write(Category:10); write(Time:10);
write(Number:12);
writeln;
end;
end;

procedure Print(var mas : Ttrains; n : integer);
var
i : integer;
begin
writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12);
for i:=1 to n do
PrintRecord(mas,i);
end;


procedure DelRecordByName(var mas : Ttrains; var n : byte; bname : string);
var
i,j : integer; {номера книг в каталоге}
begin
writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12);

for i:=1 to n do
begin
with mas[i] do

if (Otpravlenie = otpravlenie) then
begin
PrintRecord(mas,i);

for j:=i+1 to n do
mas[j-1] := mas[j];

dec(n);
end;
end;
end;


procedure FindByname(var mas : Ttrains; n : integer; botpravlenie : string);
var
i : integer;
begin
writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12);

for i:=1 to n do
with mas[i] do

if otpravlenie=botpravlenie then PrintRecord(mas,i);
end;

procedure FindByauthor(var mas : Ttrains; n : integer; ba, bst : string);
var
i : integer;
begin
writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12);

for i:=1 to n do
with mas[i] do

if (pribitie=ba) and (Category=bst) then PrintRecord(mas,i);
end;


procedure FindByyear(var mas : Ttrains; n : integer; Number : string);
var
i : integer;
begin
writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12);

for i:=1 to n do
with mas[i] do

if number=number then PrintRecord(mas,i);
end;

var
b : Ttrains;
n : byte;
punkt : byte;
subpunkt : byte;
trainotprav,
a,
st : string;
y : string;
s : string;
er : integer;

begin
n := 0;
SngWindow(1,1,80,25,WHITE,BLACK);
repeat
punkt:= Menu;
case (punkt) of
1:begin
SngWindow(1,6,80,25,WHITE,BLUE);
writeln(' ADD train');
AddRecord(b,n,max);
readkey;
end;
2:begin
SngWindow(1,6,80,25,WHITE,BLUE);
writeln(' Delete by otpravlenie');

write('Otpravlenie =>');
readln(trainotprav);

DelRecordByName(b,n,trainotprav);
readkey;
end;
3:begin
SngWindow(1,6,80,25,WHITE,BLUE);
writeln(' Catalog of trains');
Print(b,n);
readkey;
end;
4:begin
repeat
subpunkt := SubMenu;
case (subpunkt) of
1:begin
SngWindow(1,6,80,25,WHITE,BLUE);
writeln(' Train by otpravlenie ');

write('Otpravlenie =>');
readln(trainotprav);

readkey;
end;
2:begin
SngWindow(1,6,80,25,WHITE,BLUE);
writeln(' Train by pribitie and category ');

write('Pribitie =>');
readln(a);

write('Category =>');
readln(st);


readkey;
end;
3:begin
SngWindow(1,6,80,25,WHITE,BLUE);
writeln(' Train by number ');

write('number =>');
readln(y);

readkey;
end;
end;
until (subpunkt = 4);
end;
end;
until (punkt = 5);
SngWindow(1,1,80,25,WHITE,BLACK);
end.
сделать поиск
по станциям прибытия
по станциях лтправления
по времени в пути
по номеру

[НTL]

Не надо 2 массивов если работаешь с текстом. есть варианты проще:
TStringList
Пример кода : Использование строк название-значение var names : TStringList; // Определение нашей переменной списка строк ageStr : String; i : Integer; begin // Определение объекта списка строк, и указание нашей переменной на него names := TStringList.Create; // Теперь добавляем несколько названия в наш список names.CommaText := 'Neil=45, Brian=63, Jim=22'; // И теперь находим возраст Брайена ageStr := names.Values['Brian']; // Показ этого значения ShowMessage('Возраст Brian'а = '+ageStr); // Теперь отображаем все имена и значение возраста for i := 0 to names.Count-1 do begin ShowMessage(names.Names[i]+' - '+names.ValueFromIndex[i]); end; end; Возраст Brian'а 63 Neil - 45 Brian - 63 Jim - 22

Источник: http://delphibasics.ru/TStringList.php
Самое то для таких вещей
И имена можно использовать

Надо через ' '(Пробел), а не через '='

[GhostOnline]

Вообще-то, разделитель вроде как можно изменять, написано в том мане. По дефолту - да, стоит "="

Не, в том мане нет, ну вообще вот так:

В свойстве Names содержится текст до знака равенства. В свойстве values содержится текст после знака равенства по умолчанию. Однако символ-разделитель можно заменить на любой другой, использовав свойство property NameValueSeparator: Char; Доступ к значениям свойства values осуществляется по значению. Например, если в списке есть строка City=Saint-Petersburg то значение свойства value будет равно Value['City'] = 'Saint-Petersburg' Кроме этого, значение свойства value можно получить, если известен его индекс: property ValueFormlndex[Index: Integer]: string;

[fenixelite]

НTL, мой глянь, может устроит

[ErrorNeo]

вопрос:
Win7
запускаем программу, имеем варнинг:
User Account Control
Do you want to allow the following program from an unknown publisher make changes
to this computer?
как программно нажать "Yes"?

Пробовал мышью:
var TI:TInput;
begin
TI.Itype:=0;
TI.mi.dx:= 37000;
TI.mi.dy:= 37000;
TI.mi.mouseData:=0;
TI.mi.time:=0;
TI.mi.dwFlags:=MOUSEEVENTF_MOVE+MOUSEEVENTF_ABSOLU TE;
SendInput(1,TI,sizeof(TI));
TI.mi.dwFlags:=MOUSEEVENTF_LEFTDOWN;
SendInput(1,TI,sizeof(TI));
TI.mi.dwFlags:=MOUSEEVENTF_LEFTUP;
SendInput(1,TI,sizeof(TI));
end. - под Win7 не катит.
SetCursorPos(500, 500);
Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN, 500, 500, 0,0);
Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, 500,500,0,0) - под Win7 срабатывает, даже setpos не выполняется.

Пробовал клавой:
procedure SetKey(Key:Integer);
begin
keybd_event(Key,0,KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP,0);
keybd_event(Key,0,KEYEVENTF_EXTENDEDKEY,0);
keybd_event(Key,0,KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP,0);
end;

begin
SetKey(VK_LEFT);
SetKey(VK_RETURN);
end; - сам по себе код работает (на активном окне), но конкретно на этом варнинге - нет.

Не сильно рассчитываю на ответ, но если кто-то сталкивался - скажите)

[fenixelite]

Хмм странно. Только что попробовал имитировать нажатие мыши на Win7, все получилось! Попробуй это

GetCursorPos(A) // узнать текущее положение мыши (где A : TPoint)
SetCursorPos(X,Y) // установить новое положение мыши
mouse_event(MOUSEEVENTF_LEFTDOWN,X,Y,0,0) //нажать левой кнопки
mouse_event(MOUSEEVENTF_LEFTUP,X,Y,0,0) //отпустить левую кнопку


P.S наверное твоя проблема в том, что ты GetCursorPos(A) упустил :rolleyes:

[Seravin]

По моему тут лучше через handle делать.
Нагло copy/paste, автора не знаю, но исходник очень даже наплохой

unit UMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, ComCtrls, StdCtrls, ExtCtrls, ExtDlgs, Menus;

var
fmWinapi: TfmWinapi;
tnCurrent: TTreeNode;
SelWindow: HWND;

implementation
var
SelDC: HDC;

NewStyle: LongInt;
NewExStyle: LongInt;
NewClassStyle: LongInt;

{$R *.dfm}

function GetIcon(wnd:hwnd):TIcon;
begin
result:=TIcon.Create;
result.Handle:=GetClassLong(wnd,GCL_HICON);
end;

procedure SetIcon(wnd:hwnd; icon:TIcon);
begin
postmessage(wnd,wm_seticon,0,icon.Handle);
end;

function GetText(wnd:hwnd):string;
var p:array [0..256] of char;
begin
with fmWinAPi do
GetWindowText(wnd,p,255);
result:=strpas(p);
end;

procedure TfmWinapi.GetWindowParams(Wnd: HWND);
var
I, WL: LongInt;

begin
WL:= GetWindowLong(wnd, GWL_STYLE);
for I:= 0 to lvWndStyle.Items.Count -1 do
if ((LongInt(lvWndStyle.Items[i].Data)) and WL) <> 0 then lvWndStyle.Items[i].Checked:= True else lvWndStyle.Items[i].Checked:= False;

WL:= GetWindowLong(wnd, GWL_EXSTYLE);
for I:= 0 to lvExWndStyle.Items.Count -1 do
if ((LongInt(lvExWndStyle.Items[i].Data)) and WL) <> 0 then lvExWndStyle.Items[i].Checked:= True else lvExWndStyle.Items[i].Checked:= False;

WL:= GetClassLong(wnd, GCL_STYLE);
for I:= 0 to lvClassStyle.Items.Count -1 do
if ((LongInt(lvClassStyle.Items[i].Data)) and WL) <> 0 then lvClassStyle.Items[i].Checked:= True else lvClassStyle.Items[i].Checked:= False;
end;


procedure TfmWinapi.GetWindowExParams(Wnd: HWND);
var
PParam: array[0..127] of Char;
ProcId: LongInt;
hInst: THandle;
Rct: TRect;
begin
edWText.Text:= GetText(wnd); //Caption
GetClassName(wnd, PParam, 128); //Class
lbWClass.caption:= StrPas(PParam); //Class
lbWHandle.caption:= IntToStr(wnd); //Handle
lbWHmenu.caption:=IntToStr(GetMenu(wnd));// HMenu
ImWIcon.Picture.Icon:=GetIcon(wnd);
GetWindowText(GetParent(wnd), PParam, 127);//Parent Text
EdPWText.text:= StrPas(PParam); //Parent Text
lbPWHandle.caption:= IntToStr(GetParent(wnd));//Parent Handle
GetWindowRect(Wnd, Rct);
edWLeft.text:= IntToStr(Rct.Left);//Left
edWTop.text:= IntToStr(Rct.Top);//Top
edWWidth.text:= IntToStr(Rct.Right-Rct.Left);//Width
edWHeight.text:= IntToStr(Rct.Bottom-Rct.Top);//Height
edWRight.text:= IntToStr(Rct.Right);//Right
edWBottom.text:= IntToStr(Rct.Bottom);//Bottom
lbWDC.Caption:= IntToStr(SelDC); //DC
hInst:= GetWindowLong((wnd), GWL_HINSTANCE);//HInstance
lbWHinst.Caption:= IntToStr(hInst);
GetWindowThreadProcessId(wnd, @ProcId);
lbWProcId.Caption:= IntToStr(ProcId);//ProcId

end;

function ChildTree(Handle: HWND; Info: Pointer): BOOL; stdcall;
var
Text: array [0..256] of Char;
tnParent: TTreeNode;
begin
GetWindowText(handle, text, 200);
if Text <> '' then
tnParent:= fmWinapi.tvList.Items.AddChildObject(tnCurrent, StrPas(Text), TObject(Handle))
else begin
GetClassName(Handle,text,255);
tnParent:= fmWinapi.tvList.Items.AddChildObject(tnCurrent,tex t, TObject(Handle));
end;
tnParent.ImageIndex:= 1;
tnParent.SelectedIndex:= 1;
Result:= True;
end;

function ParentTree(Handle: HWND; Info: Pointer): BOOL; stdcall;
var
Text: array [0..256] of Char;
tnParent: TTreeNode;
begin
GetWindowText(handle, text, 200);
if (Text <> '') then
tnParent:= fmWinapi.tvList.Items.AddObject(nil, StrPas(Text), TObject(Handle))
else begin
GetClassName(Handle,text,255);
tnParent:= fmWinapi.tvList.Items.AddObject(nil, text, TObject(Handle));
end;
tnParent.ImageIndex:= 0;
tnParent.SelectedIndex:= 0;
Result:= True;
end;

procedure TfmWinapi.BuildTree;
var
i: integer;
begin
tvList.Items.Clear;
EnumWindows(@ParentTree, 0);
for i:= 0 to tvList.Items.Count do begin
tnCurrent:= tvList.Items[i];
EnumChildWindows(Integer(tvList.Items[i].Data), @ChildTree, 0);
end;
end;

procedure TfmWinapi.FormCreate(Sender: TObject);
var
ListItem: TListItem;
begin
btnRefresh.Click;
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_POPUP'; ListItem.Data:= TObject($80000000);
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_CHILD'; ListItem.Data:= TObject($40000000);
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_MINIMIZE'; ListItem.Data:= TObject($20000000);
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_VISIBLE'; ListItem.Data:= TObject($10000000);
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_DISABLED'; ListItem.Data:= TObject($8000000);
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_CLIPSIBLINGS'; ListItem.Data:= TObject($4000000);
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_CLIPCHILDREN'; ListItem.Data:= TObject($2000000);
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_MAXIMIZE'; ListItem.Data:= TObject($1000000);
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_CAPTION'; ListItem.Data:= TObject($C00000);
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_BORDER'; ListItem.Data:= TObject($800000);
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_DLGFRAME'; ListItem.Data:= TObject($400000);
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_VSCROLL'; ListItem.Data:= TObject($200000);
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_HSCROLL'; ListItem.Data:= TObject($100000);
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_SYSMENU'; ListItem.Data:= TObject($80000);
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_THICKFRAME'; ListItem.Data:= TObject($40000);
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_GROUP'; ListItem.Data:= TObject($20000);
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_TABSTOP'; ListItem.Data:= TObject($10000);
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_MINIMIZEBOX'; ListItem.Data:= TObject($20000);
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_MAXIMIZEBOX'; ListItem.Data:= TObject($10000);

ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_DLGMODALFRAME'; ListItem.Data:= TObject(1);
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_NOPARENTNOTIFY'; ListItem.Data:= TObject(4);
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_TOPMOST'; ListItem.Data:= TObject(8);
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_ACCEPTFILES'; ListItem.Data:= TObject($10);
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_TRANSPARENT'; ListItem.Data:= TObject($20);
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_MDICHILD'; ListItem.Data:= TObject($40);
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_TOOLWINDOW'; ListItem.Data:= TObject($80);
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_WINDOWEDGE'; ListItem.Data:= TObject($100);
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_CLIENTEDGE'; ListItem.Data:= TObject($200);
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_CONTEXTHELP'; ListItem.Data:= TObject($400);
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_RIGHT'; ListItem.Data:= TObject($1000);
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_RTLREADING'; ListItem.Data:= TObject($2000);
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_LEFTSCROLLBAR'; ListItem.Data:= TObject($4000);
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_CONTROLPARENT'; ListItem.Data:= TObject($10000);
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_STATICEDGE'; ListItem.Data:= TObject($20000);
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_APPWINDOW'; ListItem.Data:= TObject($40000);

ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_VREDRAW'; ListItem.Data:= TObject(1);
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_HREDRAW'; ListItem.Data:= TObject(2);
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_KEYCVTWINDOW'; ListItem.Data:= TObject(4);
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_DBLCLKS'; ListItem.Data:= TObject(8);
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_OWNDC'; ListItem.Data:= TObject($20);
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_CLASSDC'; ListItem.Data:= TObject($40);
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_PARENTDC'; ListItem.Data:= TObject($80);
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_NOKEYCVT'; ListItem.Data:= TObject($100);
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_NOCLOSE'; ListItem.Data:= TObject($200);
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_SAVEBITS'; ListItem.Data:= TObject($800);
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_BYTEALIGNCLIENT'; ListItem.Data:= TObject($1000);
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_BYTEALIGNWINDOW'; ListItem.Data:= TObject($2000);
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_GLOBALCLASS'; ListItem.Data:= TObject($4000);
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_IME'; ListItem.Data:= TObject($10000);

end;



procedure TfmWinapi.btnApplyClick(Sender: TObject);
var i:integer;
begin
NewStyle:= 0;
for i:= 0 to lvWndStyle.Items.Count -1 do begin
if lvWndStyle.Items[i].Checked then NewStyle:= NewStyle or LongInt(lvWndStyle.Items[i].Data);
end;

NewExStyle:= 0;
for i:= 0 to lvExWndStyle.Items.Count -1 do begin
if lvExWndStyle.Items[i].Checked then NewExStyle:= NewExStyle or LongInt(lvExWndStyle.Items[i].Data);
end;

NewClassStyle:= 0;
for i:= 0 to lvClassStyle.Items.Count -1 do begin
if lvClassStyle.Items[i].Checked then NewClassStyle:= NewClassStyle or LongInt(lvClassStyle.Items[i].Data);
end;

SetWindowLong(SelWindow, GWL_STYLE, NewStyle);
SetWindowLong(SelWindow, GWL_EXSTYLE, NewExStyle);
SetClassLong(SelWindow, GCL_STYLE, NewClassStyle);

SetWindowPos(SelWindow, HWND_TOP, StrToInt(EdWLeft.Text),StrToInt(EdWTop.Text), StrToInt(EdWWidth.Text), StrToInt(EdWHeight.Text), SWP_FRAMECHANGED);
SetIcon(SelWindow,imWIcon.picture.icon);
end;


Урезал чутьчуть.

Если хочешь могу проект просто кинуть

[fenixelite]

А че лучше то? Размер кода огромен, для того что бы всего лизь закрыть варнинг..... Хотя смотря что ТС дальше хочет делать....

[ErrorNeo]

ребят - благодарю.
Под виртуалкой не видно, как курсор движется... - он как бы остается на месте. Но нажатие кнопки происходит - там, где нужно.
"При нормальных условиях".

Хотя нажать "yes" в UAC таким образом невозможно...=\
Делаю sleep 5000, настраиваю клик в нужном месте, запускаю "опасную программу" - и фиг там) Не кликает оно по окну этому(
По обычным окнам - нормально, а по варнингу от UAC - не хочет

Буду изыскивать другие способы запустить программу, блокируемую UAC без вмешательства юзера=\

ps. так же под дефолтным "недоадминским" аккаунтом в семерке заблочены такие консольные функции, как "net user" и "at". Обе доступны только "Built-in" администратору, аккаунт которого по умолчанию disabled.
Включить его можно через lusrmgr.msc... а вот через net user - фиг(
Кстати у built-in administrator UAC вообще отключен по дефолту... как и у SYSTEM я думаю.
Тока как бы запуститься под ними из-под недоадмина без вмешательства пользователя.... :rolleyes: :confused:

[noveek]

Привет античат вопрос в следующем:

Как можно реализовать в Delphi seeders через сайт ?
Делаю некое подобие торрента

[TrueBit]

Как очистить куки в IdCookieManager1?

[Скотти]

Как очистить куки в IdCookieManager1?

Если не ошибаюсь))
IdCookieManager1.CookieCollection.Clear;

[fenixelite]

TIdCookieManager.CookieCollection.Delete();

Скотти, Точнее Delete() :rolleyes:

[qwert135]

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

[Nizhegorodets]

Как так сделать, чтобы:
Если компонент Webbrowser полностью загрузил страничку сайта, то выполняется какое-либо действие.

[AquaKlaster]

Как так сделать, чтобы:
Если компонент Webbrowser полностью загрузил страничку сайта, то выполняется какое-либо действие.

У Webbrowser есть событие OnDocumentComplite, оно тебе и поможет выполнить какое-либо действие когда страницы сайта загрузится полностью=)

[fenixelite]

В каком спискЕ? Как это с Delphi связано? Оо

[AdmSmsTel]

В каком спискЕ? Как это с Delphi связано? Оо

Может у кого есть софтина узнать сколько у меня в списке skype друзей? :rolleyes:

[fenixelite]

AdmSmsTel, спроси у AlexTheC0d3r. Он вроде со скайпом работал

[AdmSmsTel]

AquaKlaster, есть у тя такая прога?

[MaTpOc]

помогите с заданием:
последовательность z(i) задана соотношениями:

z(i)
/ i*i+cos(i)? если i-четное,
\lini/e, если i - нечетное.
i=1,2,...100
найти кол-во элементов больше 0,5.

[qwert135]

Народ помогите плиз.Пост 5724

[fenixelite]

qwert135, пример уравнение напиши, и коротко, как его решать :) Тогда посмотрим

[fenixelite]

Блин глупый вопрос, но из головы вылетело. Как создать собственный тип со значениям 192..255, при том что 255+1 = 192?

[W!z@rD]

type
myType = 192..255;

что-то вроде того, если я не путаю )))

[fenixelite]

Да это я знаю ) Но дело в том, что 255+1 не даст 192 )) Хотя взять тотже integer там high(int)+1=low(int)

[AlexTheC0d3r]

Может у кого есть софтина узнать сколько у меня в списке skype друзей? :rolleyes:
легко
напиши в асю, дам

[AdmSmsTel]

легко
напиши в асю, дам

на писал :rolleyes:

[TrueBit]

Почему когда я делаю get запрос, например:
memo1.text:=Idhttp1.get('ya.ru');
В memo вместо русских букв выводятся иероглифы какие то?
Так же происходит и тогда, когда исходник страницы сохраняешь не в memo, а в переменную...

[fenixelite]

TrueBit, попробуй кодировку менять, тут кто то писал как. Ну или обнови indy

[Volodia1981]

Отличный сайт делфи (delphicomponent.ru)
на нем вы сможете найти ответ...

[MaTpOc]

Помогите написать программу подсчета суммы элементов стоящих на четных местах в массиве из 30 чисел. Обеспечить ввод чисел:
а) с клавиатуры
б)датчиком случайных чисел

Вывести значения массива и сумму элементов.

[AlexTheC0d3r]

Отличный сайт делфи (delphicomponent.ru)
на нем вы сможете найти ответ...
отстойный сайт

удалите рекламу

[[stranger]]

Помогите написать программу подсчета суммы элементов стоящих на четных местах в массиве из 30 чисел. Обеспечить ввод чисел:
а) с клавиатуры
б)датчиком случайных чисел

Вывести значения массива и сумму элементов.
вот основа.. дальше сам допишешь?
program Project2;

{$APPTYPE CONSOLE}

uses
SysUtils;
var i,summ:integer;
m : array[1..30] of integer;

begin
summ := 0;
writeln('type array of integer');
for i:=1 to 30 do
begin
readln(m[i]);
end;
writeln('array is ready to work!');
i := 2;
while i <> 30 do
begin
summ := summ + (m[i]);
inc(i);
end;
writeln('array:');
for i:=1 to 30 do
begin
writeln(m[i]);
end;
writeln('summ: ' + inttostr(summ));
readln;
end.

[Volodia1981]

отстойный сайт

удалите рекламу

Сайт молодой - отроду 2 месяца(только развивается) На все мои вопросы он отвечает. Это ещё не говорит что он отстойный! :mad:

[AlexTheC0d3r]

Сайт молодой - отроду 2 месяца(только развивается) На все мои вопросы он отвечает. Это ещё не говорит что он отстойный! :mad:
не стоит рекомендовать такой молодой сайт, как тот, который отвечает на любой вопрос

[xaldey]

Пытаюсь в другой программе в текстовое окно вставить текст, ищу нужное окно, в нем через GetClassName получаю название класса, так как едитов много то GetClassName дает одинаковый результат для всех элементов, как их перебрать???? Если смотрю с помощью Autoit Info Tool, он находит: >>>> Control <<<< Class:TEditControl Instance:1.
Class:TEditControl - получает через GetClassName, а как получает Instance:1 - хз.

[Soherox]

Помогите написать программу подсчета суммы элементов стоящих на четных местах в массиве из 30 чисел. Обеспечить ввод чисел:
а) с клавиатуры
б)датчиком случайных чисел

Вывести значения массива и сумму элементов.
под а)

{$APPTYPE CONSOLE}

const
size = 30;
var
a: array [1..size] of integer;
i: byte;
sum: integer;
begin
sum:=0;
for i:=1 to size do
begin
readln(a[i]);
if i mod 2 = 0 then inc(sum, a[i]);
end;
for i:=1 to size do write(a[i],' ');
writeln;
writeln(sum);
readln;
end.


И под b)

{$APPTYPE CONSOLE}

const
size = 30;
ch = 500;
var
a: array [1..size] of integer;
i: byte;
sum: integer;
begin
sum:=0;
randomize;
for i:=1 to size do
begin
a[i]:=random(ch);
if i mod 2 = 0 then inc(sum, a[i]);
end;
for i:=1 to size do write(a[i],' ');
writeln;
writeln(sum);
readln;
end.

[flacs]

Как в TICQClient реализовать, что уин изпользовал Webaware(чтобы уины были видны в поиске, зелененьким цветом)

применяю функцию
SetAuthorization(false, true);

второй флаг из этой функции должен включать данную фичу, но в поиске уин (серенький) - inv

Посоветуйте что можно сделать?

[Seravin]

Пытаюсь в другой программе в текстовое окно вставить текст, ищу нужное окно, в нем через GetClassName получаю название класса, так как едитов много то GetClassName дает одинаковый результат для всех элементов, как их перебрать???? Если смотрю с помощью Autoit Info Tool, он находит: >>>> Control <<<< Class:TEditControl Instance:1.
Class:TEditControl - получает через GetClassName, а как получает Instance:1 - хз.

Проект в котором реализована работа в winapi(там ты найдёшь что тебе нужно, и, я думаю, узнаешь много интересного)
http://depositfiles.com/files/i9dhpjgnz

[iGlass]

Народ хелп ми плиз.. Сижу чёто тупикую

Вот вопрос:

Я загрузил текст в лист, ну не совсем текст а хтмл мне нужен только кусок этой страницы.

Кусок может быть разной длины!

Как удалить всё до куска и после него ? Заранее спасибо)

[=Zeus=]

Народ хелп ми плиз.. Сижу чёто тупикую

Вот вопрос:

Я загрузил текст в лист, ну не совсем текст а хтмл мне нужен только кусок этой страницы.

Кусок может быть разной длины!

Как удалить всё до куска и после него ? Заранее спасибо)
Что такое лист? Думаю тебе нужно смотреть в сторону ф-ции Delete(строка, с какого символа, по какой символ)

[denjf]

Подскажите на примере как создать свое событие в Delphi.

Допустим я хочу создать событие onDenjf

И что бы он происходило по нажатию на button

procedure Tform1.buttonclick(sender:object);
begin
//.....
//как я понял тут надо написать
If Assigned(FOndenjf) then FOondenjf(self);
end;

обработчик
procedure trorm1.ondenjf(sender:object);
begin
///тут че нибуть делаем
end;

Что нужно добавить еще?

[Seravin]

Подскажите на примере как создать свое событие в Delphi.

Допустим я хочу создать событие onDenjf

И что бы он происходило по нажатию на button

procedure Tform1.buttonclick(sender:object);
begin
//.....
//как я понял тут надо написать
If Assigned(FOndenjf) then FOondenjf(self);
end;

обработчик
procedure trorm1.ondenjf(sender:object);
begin
///тут че нибуть делаем
end;

Что нужно добавить еще?
Если не ошибаюсь, то так:
Button1.Onclick:=ondenjf;

[GhostOnline]

Надо соответсвенно объявить процедурный тип и свойство-событие:



TMyClass = class
...........
private
FOnDenjf : TNotifyEvent;
............
public
property OnDenjf: TNotifyEvent read FOnDenjf write FOnDenjf;
end;

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

Вместо TNotifyEvent ты можешь объявить свой процедурный тип:

type
TMyEvent = procedure of object({тут перечисление передаваемых аргументов по твоему усмотению});
end;

[Seravin]

Надо соответсвенно объявить процедурный тип и свойство-событие:



TMyClass = class
...........
private
FOnDenjf : TNotifyEvent;
............
public
property OnDenjf: TNotifyEvent read FOnDenjf write FOnDenjf;
end;

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

Вместо TNotifyEvent ты можешь объявить свой процедурный тип:

type
TMyEvent = procedure of object({тут перечисление передаваемых аргументов по твоему усмотению});
end;
а не проще в public объявить свою процедуру с параметрами как в процедуре, которая должна вызвать это событие, и написать так как я?