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

[Sokolik]

procedure TForm1.ReadParams;
Var IniFile: TIniFile;
begin
IniFile:=TIniFile.Create('abc.ini');
xppanel1.Caption:=IniFile.ReadString('FORM1','Pane l',xppanel1.Caption);
IniFile.Free;
end;

procedure TForm1.WriteParams;
Var IniFile: TIniFile;
begin
IniFile:=TIniFile.Create('abc.ini');
IniFile.WriteString('FORM1','Panel',xppanel1.Capti on);
IniFile.Free;
end;

Как сделать, чтобы в abc.ini текст хранился в шифрованном, а не в открытом виде? Метод шифрования можно самый простой. Желательно показать примерчик. Заранее спасибо всем кто ответит.

[StealthMaster]

procedure TForm1.ReadParams;
Var IniFile: TIniFile;
begin
IniFile:=TIniFile.Create('abc.ini');
xppanel1.Caption:=IniFile.ReadString('FORM1','Pane l',xppanel1.Caption);
IniFile.Free;
end;

procedure TForm1.WriteParams;
Var IniFile: TIniFile;
begin
IniFile:=TIniFile.Create('abc.ini');
IniFile.WriteString('FORM1','Panel',xppanel1.Capti on);
IniFile.Free;
end;

Как сделать, чтобы в abc.ini текст хранился в шифрованном, а не в открытом виде? Метод шифрования можно самый простой. Желательно показать примерчик. Заранее спасибо всем кто ответит.

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


procedure TForm1.WriteParams;
Var
IniFile: TIniFile;
OpenText, CloseText: string;
begin
... выполнение неободимых действий
// в OpenText хранится текст для записи
// Encrypt - функция шифрования, которой передаются следующие параметры: текст и ключ для шифрования

CloseText := EnCrypt(OpenText, Key);
IniFile:=TIniFile.Create('abc.ini');
IniFile.WriteString('Section','PName', CloseText);
IniFile.Free;
end;


procedure TForm1.ReadParams;
Var
IniFile: TIniFile;
OpenText, CloseText: string;
begin
// Decrypt - функция расшифрования, которой передаются следующие параметры: текст и ключ для шифрования

IniFile:=TIniFile.Create('abc.ini');
CloseText := IniFile.ReadString('Section','PName', '');
IniFile.Free;
OpenText := Decrypt(CloseText, key);
end;


Если нужен простейший пример шифрования, то вот класс описывающий шифрование Виженера:

unit VigenereCrypt;

interface

uses Classes;

type
TVigenereCrypt = class
Alphabet: string; // алфавит
Mask: TStrings; // маска шифрования
TabulaRecta: TStrings;

constructor Create;
procedure CreateMask;
procedure Encrypt;
procedure Decrypt;
end;

implementation

constructor TVigenereCrypt.Create;
var
i, j: byte;
tmp: string;
tmpint: byte;
begin
Alphabet := 'абвгдеёжзийклмнопрстуфхц� �шщъыьэюя0123456789$!.,?;*(){}+=:/[]@\^"';

// создадим строковые списки
InputText := TStringList.Create;
OutputText := TStringList.Create;
Mask := TStringList.Create;
TabulaRecta := TStringList.Create;

for i := 0 to 63 do
begin
tmp := Alphabet;
for j := 1 to 64 do
begin
tmpint := (j+i) mod 64;
if (tmpint = 0) then
tmp[j] := Alphabet[64]
else
tmp[j] := Alphabet[tmpint];
end;
TabulaRecta.Append(tmp);
end;
end;



procedure TVigenereCrypt.CreateMask;
var
// длина ключа и текущий индекс символа в ключе
KeyLength: integer;
index: integer;

// счетчики циклов
i, j: integer;

// временные переменные
tmp: string;
begin
KeyLength := Length(key);
index := 1;
for i := 0 to InputText.Count -1 do
begin
SetLength(tmp, length(InputText[i]));
for j := 1 to length(InputText[i]) do
begin
tmp[j] := key[index];
inc(index);
if (index = KeyLength +1) then
index := 1;
end;
Mask.Append(tmp);
end;
end;


procedure TVigenereCrypt.Encrypt;
var
i,j : integer;
tmp : string;
index, tmpint: integer;
begin
for i := 0 to InputText.Count - 1 do
begin
// установим длину временной строки
SetLength(tmp,Length(InputText[i]));

// посимвольно обрабатываем строку
for j := 1 to Length(InputText[i]) do
begin
tmpint := POS(InputText[i][j], Alphabet);
// если символ не из алфавита, то пропустим его
if (tmpint = 0) then
tmp[j] := InputText[i][j]
// иначе обрабатываем
else
begin
index := POS(Mask[i][j], Alphabet)-1;
tmp[j] := TabulaRecta[index][tmpint];
end; // else
end; // for j

// добавим строку к обработанному тексту
OutputText.Append(tmp);
end; // for i
end;


procedure TVigenereCrypt.Decrypt;
var
i,j : integer;
tmp : string;
index, tmpint: integer;
begin
for i := 0 to InputText.Count - 1 do
begin
// установим длину временной строки
SetLength(tmp,Length(InputText[i]));

// посимвольно обрабатываем строку
for j := 1 to Length(InputText[i]) do
begin
index := POS(Mask[i][j], Alphabet)-1;
// если символ не из алфавита, то пропустим его
if (POS(InputText[i][j], Alphabet) = 0)
then tmp[j] := InputText[i][j]
// иначе обрабатываем его
else
begin
tmpint := POS(InputText[i][j], TabulaRecta[index]);
tmp[j] := Alphabet[tmpint];
end; // else
end; // for j

// добавим строку к обработанному тексту
OutputText.Append(tmp);
end; // for i
end;

end.


При использовании процедуры Encrypt этого класса будут зашифрованы все строчные символы кирилицы, цифры и некоторые символы. Всегда можешь изменить алфавит и немного доработать класс.

Использовать тогда шифрование нужно так:

procedure TForm1.WriteParams;
Var
IniFile: TIniFile;
CloseText: string;
Crypt: TVigenereCrypt;
begin
Crypt:= TVigenereCrypt.Create;
Crypt.key := 'ялюблюантичат';
Crypt.InputText.Clear;
Crypt.InputText.Append(xppanel1.Caption);
Crypt.CreateMask;
Crypt.Encrypt;
CloseText := Crypt.OutputText[0];

IniFile:=TIniFile.Create('abc.ini');
IniFile.WriteString('FORM1','Panel', CloseText);
IniFile.Free;
end;


procedure TForm1.ReadParams;
Var
IniFile: TIniFile;
tmpstr: string;
Crypt: TVigenereCrypt;
begin
Crypt:= TVigenereCrypt.Create;
Crypt.key := 'ялюблюантичат';

IniFile:=TIniFile.Create('abc.ini');
tmpstr:= IniFile.ReadString('FORM1','Panel', 'lalala');
IniFile.Free;

Crept.InputText.clear;
Crypt.InputText.Append(tmpstr);
Crypt.CreateMask;
Crypt.Decrypt;

xppanel1.Caption:= Crypt.OutputText[0];
end;


P.S. все кроме класса писал прямо здесь, мог где то ошибиться.

[Пуховой]

KaZ@NoVa, спасибо вам!

Еще немного поковырялся с проблемой. Выяснилось, что до 30-ти потоков включительно, память программа не кушает (11-12 мб, 30 мин. тест). При запуске более 50-ти потоков - начинается веселье (80-100 мб на 8-10 мин. работы, до 500 мб на 30-й).

[Sokolik]

StealthMaster, спасибо! Пойду проверять как работает.

[Пуховой]

Использую Delphi 7 & Indy 10.5.7 (rev. 3880+)

Письма в TIdMessage отдаются в unicode.

Вопрос - как конвертировать в ansi формат тело письма?

[KaZ@NoVa]

Использую Delphi 7 & Indy 10.5.7 (rev. 3880+)

Письма в TIdMessage отдаются в unicode.

Вопрос - как конвертировать в ansi формат тело письма?

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

[Пуховой]

Проблема решена переходом на Delphi 2010.

[mobilka]

помогите вывести данные в memo
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
s,temp: string;

begin

if pos('00',edit1.text) <> 0 then
for i:=1 to length(edit1.text) div 2 do temp:=temp+copy(edit1.text,i*4-3,2)
else temp:=edit1.text;
for i:=1 to length(temp) div 2 do s:=s+chr(hextoint(copy(temp,i*2-1,2)));
caption:=s;
end;
как видно сейчас выводятся в caption формы а надо в memo1

[МongBa†]

mobilka
заменить весь текст в мемо Memo1.Text:=s;
либо добавить строку Memo1.Lines.Add(s);

[Пуховой]

Использую Delphi 2010 & Indy 10.5.7 (rev. 3880+)

При отправке POST запроса, он автоматически кодируется в unicode (TIdURI.ParamsEncode не предлагать). Соответственно, ansi - строки отправить не получается. Ищу универсальное решение, пока что сделал функцию:

function httppost (http : tidhttp; adr : string; post : tstringlist) : string;
function urlencode (str : ansistring) : ansistring;
function chartohex (ch : ansichar) : integer;
asm
and eax, 0FFh
mov ah, al
shr al, 4
and ah, 00fh
cmp al, 00ah
jl @@10
sub al, 00ah
add al, 041h
jmp @@20
@@10:
add al, 030h
@@20:
cmp ah, 00ah
jl @@30
sub ah, 00ah
add ah, 041h
jmp @@40
@@30:
add ah, 030h
@@40:
shl eax, 8
mov al, '%'
end;

var
i, len : integer;
ch : ansichar;
n : integer;
p : pansichar;
begin
Result := '';
len := length (str);
p := pansichar (@N);
for i := 1 to len do
begin
Ch := Str[i];
if ch in ['0'..'9', 'A'..'Z', 'a'..'z', '_', '='] then Result := Result + ch else
begin
if ch = ' ' then Result := Result + '+' else
begin
n := chartohex (ch);
Result := Result + p;
end;
end;
end;
end;
var
str : tstringstream;
i : integer;
m : ansistring;
isansi : boolean;
begin
isansi := false;
str := tstringstream.create('');
m := post.gettext;
for i := 1 to length (m) do if m[i] in ['а'..'я', 'А'..'Я', 'ё', 'Ё'] then isansi := true;
if isansi = true then
begin
http.httpoptions := [];
for i := 0 to post.count - 1 do post.strings[i] := urlencode (post.strings[i]);
try http.post (adr, post, str); except end;
http.httpoptions := [hoforceencodeparams];
end else
begin
try http.post (adr, post, str); except end;
end;
Result := str.datastring;
str.free;
end;

Но, как видите, громоздко и не эстетично. Напомню, речь о Delphi 2010, где string по-умолчанию - unicodestring.

[mobilka]

mobilka
заменить весь текст в мемо Memo1.Text:=s;
либо добавить строку Memo1.Lines.Add(s);
спасибо. а как в listbox вывести?
разобрался- Listbox1.Items.Add(s);

[P.A.U.L]

[Pascal]
Помогите доделать программу:

Задание звучит так:

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

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

program matr1;
uses crt;
const n=5;
const m=10;
type s=array[1..n,1..m] of integer;
const a:s=((1,1,1,1,1,6,7,8,9,10),
(1,2,2,2,5,6,7,8,9,10),
(1,2,3,3,5,6,7,8,9,10),
(1,7,7,7,7,7,7,7,7,10),
(1,2,3,7,7,7,7,7,7,10));
var i,j,gl,loc,r,x,k:integer;
b: array[1..n] of integer;
begin
clrscr;
writeln('Исходная матрица:');
for i:=1 to n do
begin
for j:=1 to m do
begin
write(a[i,j]:3);
end;
writeln;
end;
{Подсчет количества одинаковых элементов}
for i:=1 to n do begin
gl:=0;
for j:=1 to m-1 do begin
loc:=1;
for r:=j+1 to m do
if a[i,j]=a[i,r] then loc:=loc+1;
if loc>gl then begin gl:=loc; loc:=0 end;
end;
b[i]:=gl;
end;
for i:=1 to n do write(b[i],' ');
writeln;
for i:=1 to n-1 do begin
x:=b[i]; k:=i;
for j:=i+1 to n do
if b[j]<x then begin x:=b[j]; k:=j end;
b[k]:=b[i]; b[i]:=x;

(Вот здесь чего то нехватает)

end;
for i:=1 to n do write(b[i],' ');
writeln;
readkey;
end.

[StealthMaster]

[Pascal]
Помогите доделать программу:

Задание звучит так:

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

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

program matr1;
uses crt;
const n=5;
const m=10;
type s=array[1..n,1..m] of integer;
const a:s=((1,1,1,1,1,6,7,8,9,10),
(1,2,2,2,5,6,7,8,9,10),
(1,2,3,3,5,6,7,8,9,10),
(1,7,7,7,7,7,7,7,7,10),
(1,2,3,7,7,7,7,7,7,10));
var i,j,gl,loc,r,x,k:integer;
b: array[1..n] of integer;
begin
clrscr;
writeln('Исходная матрица:');
for i:=1 to n do
begin
for j:=1 to m do
begin
write(a[i,j]:3);
end;
writeln;
end;
{Подсчет количества одинаковых элементов}
for i:=1 to n do begin
gl:=0;
for j:=1 to m-1 do begin
loc:=1;
for r:=j+1 to m do
if a[i,j]=a[i,r] then loc:=loc+1;
if loc>gl then begin gl:=loc; loc:=0 end;
end;
b[i]:=gl;
end;
for i:=1 to n do write(b[i],' ');
writeln;
for i:=1 to n-1 do begin
x:=b[i]; k:=i;
for j:=i+1 to n do
if b[j]<x then begin x:=b[j]; k:=j end;
b[k]:=b[i]; b[i]:=x;

(Вот здесь чего то нехватает)

end;
for i:=1 to n do write(b[i],' ');
writeln;
readkey;
end.

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

На мой взгляд, было бы удобнее использовать массив записей

type
TMatrixStrings = record
StringNumber: integer;
Count: integer;
end;

Где count - количество элементов, которые чаще всего повторялись в строке матрицы.
Упорядочить этот массив по полю count, а затем вывести матрицу.


program matr1;
uses crt;
const n=5;
const m=10;
type s=array[1..n,1..m] of integer;
const a:s=((1,1,1,1,1,6,7,8,9,10),
(1,2,2,2,5,6,7,8,9,10),
(1,2,3,3,5,6,7,8,9,10),
(1,7,7,7,7,7,7,7,7,10),
(1,2,3,7,7,7,7,7,7,10));

type
TMatrixStrings = record
StringNumber: integer;
Count: integer;
end;


var i, j, gl, loc, r, x, k: integer;
b: array[1..n] of TMatrixStrings;
begin
clrscr;
writeln('Исходная матрица:');
for i:=1 to n do
begin
for j:=1 to m do
begin
write(a[i,j]:3);
end;
writeln;
end;

{Подсчет количества одинаковых элементов}
for i:=1 to n do begin
gl:=0;
for j:=1 to m-1 do begin
loc:=1;
for r:=j+1 to m do
if a[i,j]=a[i,r] then loc:=loc+1;
if loc>gl then begin gl:=loc; loc:=0 end;
end;
b[i].count:=gl;
b[i].StringNumber := i;
end;

for i:=1 to n do
write(b[i].count,' ');

writeln;

// сортировка
for i:=1 to n-1 do
begin
x:=b[i].count; k:=i;
for j:=i+1 to n do
if b[j].count<x then
begin
x:=b[j].count;
k:=j;
end;
b[k].count:=b[i].count;
b[i].count:=x;

x := b[i].StringNumber;
b[i].StringNumber := b[k].StringNumber
b[k].StringNumber := x;
end;

// вывод упорядоченной матрицы
for i:=1 to n do
writeln(a[b[i].StringNumber]);
writeln;
readkey;
end.


Писал без паскаля, возможно где-то ошибся.

[mobilka]

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

[МongBa†]

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

if opendialog.execute then listbox.items.loadfromfile(opendialog.filename);

[mobilka]

if opendialog.execute then listbox.items.loadfromfile(opendialog.filename);
спасибо. теперь нужно следующее-
имеем файл .txt
в нем информация вида-
[1]
09843075432
[2]
7854325890863216809765434
[3]
65D432
и т.д т.п
нужно выдернуть определенный блок например [2] и его содержимое т.е 7854325890863216809765434 вывести в тот же листбокс

[P.A.U.L]

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

[=Zeus=]

спасибо. теперь нужно следующее-
имеем файл .txt
в нем информация вида-
[1]
09843075432
[2]
7854325890863216809765434
[3]
65D432
и т.д т.п
нужно выдернуть определенный блок например [2] и его содержимое т.е 7854325890863216809765434 вывести в тот же листбокс
Тебе же написали, за загрузку из файла в листбок отвечает функция listbox.items.loadfromfile('тут твой путь+имя файла');
Можешь использовать скрытый лист-бокс как буфер, и если тебе нужно 2-ю строку, то бери оттуда вторую строку ListBox2.Items[2] и добавляй ее в свой видимый листбокс.
ListBox1.Items.Add(ListBox2.Items[2]);
Лучше было бы конечно создавать стринг лист в памяти, но смотри сам.

[wolmer]

нужно выдернуть определенный блок например [2] и его содержимое т.е 7854325890863216809765434 вывести в тот же листбокс
"Работа с ini файлами" в гугле

[mobilka]

Тебе же написали, за загрузку из файла в листбок отвечает функция
Можешь использовать скрытый лист-бокс как буфер, и если тебе нужно 2-ю строку, то бери оттуда вторую строку ListBox2.Items[2] и добавляй ее в свой видимый листбокс.
ListBox1.Items.Add(ListBox2.Items[2]);
Лучше было бы конечно создавать стринг лист в памяти, но смотри сам.

блин выдирает не то что нужно. а именно-
в листбокс 2 загружается-
[1]
09843075432
[2]
7854325890863216809765434
[3]
65D432
в листбокс1 выводит вторую строчку-
09843075432
а нужно 7854325890863216809765434
а если файл содержит всего одну строчку то программа вылетает с ошибкой.
p.s заменить [2] на [4] я догадался но это не то что нужно.

[P.A.U.L]

[Pascal]И еще вот эту помогите доработать чутка...

Вот так звучит задача: Дана строка символов, удалить из нее все строчные латинские символы)

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

uses crt;
var s:string;
i,l:integer;
begin
clrscr;
write('stroka: '); readln(s);
l:=length(s);

for i:=1 to l do begin
if (s[i]=(chr(97))) or (s[i]=(chr(98))) or (s[i]=(chr(99))) or (s[i]=(chr(100)))or
(s[i]=(chr(101)))or(s[i]=(chr(102)))or(s[i]=(chr(103)))or(s[i]=(chr(104)))or
(s[i]=(chr(105)))or(s[i]=(chr(106)))or(s[i]=(chr(107)))or(s[i]=(chr(108)))or
(s[i]=(chr(109)))or(s[i]=(chr(110)))or(s[i]=(chr(111)))or
(s[i]=(chr(112)))or(s[i]=(chr(113)))or(s[i]=(chr(114)))or(s[i]=(chr(115)))or
(s[i]=(chr(116)))or(s[i]=(chr(117)))or(s[i]=(chr(118)))or
(s[i]=(chr(119)))or(s[i]=(chr(120)))or(s[i]=(chr(121))) or
(s[i]=(chr(122)))or(s[i]=(chr(123)))or(s[i]=(chr(124)))

then delete(s,i,1)
end;
writeln(s);
readln;
end.

[speles]

to P.A.U.L.
коряво но всеже
uses crt;
var s,ss:string;
i,l:integer;
begin
clrscr;
write('stroka: '); readln(s);
l:=length(s);

for i:=1 to l do begin
if not ((s[i]=(chr(97))) or (s[i]=(chr(98))) or (s[i]=(chr(99))) or (s[i]=(chr(100)))or
(s[i]=(chr(101)))or(s[i]=(chr(102)))or(s[i]=(chr(103)))or(s[i]=(chr(104)))or
(s[i]=(chr(105)))or(s[i]=(chr(106)))or(s[i]=(chr(107)))or(s[i]=(chr(108)))or
(s[i]=(chr(109)))or(s[i]=(chr(110)))or(s[i]=(chr(111)))or
(s[i]=(chr(112)))or(s[i]=(chr(113)))or(s[i]=(chr(114)))or(s[i]=(chr(115)))or
(s[i]=(chr(116)))or(s[i]=(chr(117)))or(s[i]=(chr(118)))or
(s[i]=(chr(119)))or(s[i]=(chr(120)))or(s[i]=(chr(121))) or
(s[i]=(chr(122)))or(s[i]=(chr(123)))or(s[i]=(chr(124))))

then ss := ss + s[i]
end;
writeln(ss);
readln;
end.

[mobilka]

блин выдирает не то что нужно. а именно-
в листбокс 2 загружается-
[1]
09843075432
[2]
7854325890863216809765434
[3]
65D432
в листбокс1 выводит вторую строчку-
09843075432
а нужно 7854325890863216809765434
а если файл содержит всего одну строчку то программа вылетает с ошибкой.
p.s заменить [2] на [4] я догадался но это не то что нужно.
помогите пожалуйста

[P.A.U.L]

speles, спс огромное, работает:)

[mobilka]

вроде нашел то что нужно только осталось найти сдесь ошибку-
procedure TForm1.Button2Click(Sender: TObject);
var TS : TStringList;
i: integer;
s: string;
begin
if OpenDialog1.Execute then

TS := TStringList.Create;
TS.LoadFromFile(OpenDialog1.FileName);
TS.IndexOf('[3]');
Pos('0=', TS.Strings[i]);
Listbox1.Items.Add(s);
end;
не выводит в листбокс ничего

[wolmer]

вроде нашел то что нужно только осталось найти сдесь ошибку-

не выводит в листбокс ничего
procedure TForm1.Button2Click(Sender: TObject);
var TS : TStringList;
i: integer;
s: string;
begin
if OpenDialog1.Execute then
begin
TS := TStringList.Create;
TS.LoadFromFile(OpenDialog1.FileName);
TS.IndexOf('[3]');
Pos('0=', TS.Strings[i]);
Listbox1.Items.Add(s);
end;
end;

[mobilka]

procedure TForm1.Button2Click(Sender: TObject);
var TS : TStringList;
i: integer;
s: string;
begin
if OpenDialog1.Execute then
begin
TS := TStringList.Create;
TS.LoadFromFile(OpenDialog1.FileName);
TS.IndexOf('[3]');
Pos('0=', TS.Strings[i]);
Listbox1.Items.Add(s);
end;
end;
и все равно листбокс после загрузки пустой

[wolmer]

и все равно листбокс после загрузки пустой
А блин точно, пропустил кое что

Listbox1.Items.Add(s);
Ну а в переменной s ниче ж нету! Если несправишся то расскажи собственно что программа должна делать?

[mobilka]

А блин точно, пропустил кое что

Listbox1.Items.Add(s);
Ну а в переменной s ниче ж нету! Если несправишся то расскажи собственно что программа должна делать?
так рассказывал вроде выше. имеем файл .txt с содержанием-
[3]
0=34534D9304
задача получить значение 34534D9304 в листбоксе

[=Zeus=]

Блин ну вы жжоте :D

procedure TForm1.Button1Click(Sender: TObject);
var
TS : TStringList;
i: integer;
begin
if OpenDialog1.Execute then
begin
TS := TStringList.Create;
TS.LoadFromFile(OpenDialog1.FileName);
i:=TS.IndexOf('[3]');
Listbox1.Items.Add(TS[i+1]);
end;
end;
Так тебе нужно? Мобилка ты вообще делфи хоть чуть-чуть знаешь? Такое ощущение что ты его первый раз видишь. Мне не жалко накодить готовое, но ты должен сам учиться!

[mobilka]

=Zeus= почти так. код выводит стороку 0=34534D9304 а нужно без 0= т.е 34534D9304
так я же и учу потихоньку

[=Zeus=]

=Zeus= почти так. код выводит стороку 0=34534D9304 а нужно без 0= т.е 34534D9304
так я же и учу потихоньку
У тебя во всех строках будет "0="? Если да то просто поменяй
Listbox1.Items.Add( Copy(TS[i+1], 3, length(TS[i+1]) ) );
Это значит что мы добавим строку с 3-его символа до последнего. то есть без первых двух символов "0=". Фактически нам не важно, какие будут первые 2 символа.

...
Блин, тут экстрасенсов нету. Я на твой вопрос ответил. Ты сказал что тебе нужно, я написал код.
Я спать.

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

[mobilka]

У тебя во всех строках будет "0="? Если да то просто поменяй
Listbox1.Items.Add( Copy(TS[i+1], 3, length(TS[i+1]) ) );
Это значит что мы добавим строку с 3-его символа до последнего. то есть без первых двух символов "0=".
нет не во всех. и если в файле нет блока [3] то выбирается первый почему то. а желательно что бы посылалось сообщение в листбокс - block 3 not found

[МongBa†]

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

В Uses дописываем IniFiles
и кнопочка:
procedure TForm1.Button1Click(Sender: TObject);
var blocks:TStringList;
ini:TIniFile;
i:integer;
s:string;
begin
blocks:=TStringList.Create;
ini:=TIniFile.Create('.\file.txt'); //связываем переменную с файлом
ini.ReadSections(blocks); //считываем в стринглист все "блоки"
blocks.Sort; // обязательно для поиска по стринглисту
if blocks.Find('3',i) then //ищем "блок" [3] - без скобок
begin
s:=ini.ReadString('3','0','Значение 0 не найдено');
ListBox1.Items.Add(s); //запивывает значение если найдено, если нет верхнюю фразу
end
else ListBox1.Items.Add('Block 3 not found'); //ну и это если сам блок не найден
end; Все другие операции так же можно реализовать в пару строк а не делать "обрезание" по символу = или скобкам :p

[Freedom]

Блин ребят уже запарился с этой штукой. инди 10. как в мемо вывести нормальный текст а не типа такого "?iaaen.Aaiuae"

[denjf]

Вот попрос о работе с idhttp.

Вообщем делаю брут.

Все брутит хорошо но иногда выкидывает ошибку Timeout.

Я прописал ReadTimeout:=30000.
Долго брутило все було хорошо но потом выкинуло ошибку Error ReadTimeout

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


дупустим

http1.readtimeout:=30000;
http1.get('sait.com');

если мы не получили ответ то заного пытаемся выполнить http1.get('sait.com');

[Пуховой]

Freedom, в свое время писал функцию:

function httpget (http : tidhttp; adr : widestring) : widestring;
var
str : tstringstream;
begin
str := tstringstream.Create('');
try http.Get (adr, str); except end;
Result := str.DataString;
str.Free;
end;

Вызов - s := httpget (http, 'http://vkontakte.ru');

Но советую вам на юникодную delphi пересесть - проблем знать не будете.

[RumShun]

denjf, попробуй использовать исключения
try
//code
except
end;
простейший пример

[mobilka]

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

В Uses дописываем IniFiles
и кнопочка:
procedure TForm1.Button1Click(Sender: TObject);
var blocks:TStringList;
ini:TIniFile;
i:integer;
s:string;
begin
blocks:=TStringList.Create;
ini:=TIniFile.Create('.\file.txt'); //связываем переменную с файлом
ini.ReadSections(blocks); //считываем в стринглист все "блоки"
blocks.Sort; // обязательно для поиска по стринглисту
if blocks.Find('3',i) then //ищем "блок" [3] - без скобок
begin
s:=ini.ReadString('3','0','Значение 0 не найдено');
ListBox1.Items.Add(s); //запивывает значение если найдено, если нет верхнюю фразу
end
else ListBox1.Items.Add('Block 3 not found'); //ну и это если сам блок не найден
end; Все другие операции так же можно реализовать в пару строк а не делать "обрезание" по символу = или скобкам :p
спасибо. только почему то в любом случае посылается сообщение а блок не показывается. разобрался. спасибо

[ZET36]

У меня вопрос по прехвату api функций, использовал эту статью
http://www.xakep.ru/post/22263/default.asp

Вызываю замену апи функции на свою(в инжектируемой библиотеке)
InterceptDllCall(hInstance, 'user32.dll', 'MessageBoxA',Pointer(@MyMessageBox), nil, Pointer(myProc));

Вот описание, что бы было понятней


function InterceptDLLCall(hLocalModule: HModule; c_szDllName, c_szApiName:PChar;
pApiNew, pApiToChange: Pointer; var p_pApiOrg: Pointer): boolean;

hLocalModule: HModule; – модуль в котором находиться Import Table
c_szDllName:PChar; – имя DLL, в которой находиться перехватываемая функция
c_szApiName:PChar; – имя перехватываемой функции
pApiNew: Pointer; – указатель на нашу функцию, которая будет вызываться вместо перехватываемой.
pApiToChange: Pointer; – указатель на перехватываемую функцию, если равно nil, то адрес функции определяется через c_szDllName и c_szApiName.
p_pApiOrg: Pointer; – указатель на старую перехватываемую функцию



но проблема вот в чём, замена функции работает только в инжектируемой библиотеке, а не в самом приложении куда я её инжектирую.
Даю гарантию это из за hLocalModule так как hInstance - дескриптор текущего экземпляра приложения, которым является инжектируемая библиотека а не само приложение.
Так как же мне узнать HModule этого приложения?

[ZiGGi]

как сделать такой элемент в Delphi 7.0?
http://s48.radikal.ru/i119/0911/65/6f9cfedb6c7a.png

[StealthMaster]

как сделать такой элемент в Delphi 7.0?
http://s48.radikal.ru/i119/0911/65/6f9cfedb6c7a.png

Возьми Memo, задай цвет, отключи полосы прокрутки (ScrollBars := ssNone), укажи выравнивание по правому краю (Alignment := taRightJustify).

[mobilka]

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

В Uses дописываем IniFiles
и кнопочка:
procedure TForm1.Button1Click(Sender: TObject);
var blocks:TStringList;
ini:TIniFile;
i:integer;
s:string;
begin
blocks:=TStringList.Create;
ini:=TIniFile.Create('.\file.txt'); //связываем переменную с файлом
ini.ReadSections(blocks); //считываем в стринглист все "блоки"
blocks.Sort; // обязательно для поиска по стринглисту
if blocks.Find('3',i) then //ищем "блок" [3] - без скобок
begin
s:=ini.ReadString('3','0','Значение 0 не найдено');
ListBox1.Items.Add(s); //запивывает значение если найдено, если нет верхнюю фразу
end
else ListBox1.Items.Add('Block 3 not found'); //ну и это если сам блок не найден
end; Все другие операции так же можно реализовать в пару строк а не делать "обрезание" по символу = или скобкам :p
подскажите где тут происходит обрезание первых двух значений в строке?

[StealthMaster]

подскажите где тут происходит обрезание первых двух значений в строке?


s:=ini.ReadString('3','0','Значение 0 не найдено');


Вот здесь считывается из блока [3] строка соответствующая "0=". 0 в данном случае является именем сохраненной строки, = - просто разделитель. Поэтому никакого "обрезания" после считывания делать не приходится.

[mobilka]

begin
if OpenDialog1.Execute then
begin
blocks:=TStringList.Create;
ini:=TIniFile.Create(OpenDialog1.FileName);
ini.ReadSections(blocks);
blocks.Sort;
if blocks.Find('3',i) then
begin
s:=ini.ReadString('3','0','Çíà÷åíèå 0 íå íàéäåíî');

end
else ListBox1.Items.Add('Block 3 not found');
begin
for i:=1 to length(s) do if copy(s,i,1)='0' then continue else break;
temp:=copy(s,i,length(s)-i+1);
ListBox1.Items.Add(temp);
end;
end;
end;
вот придумали но работать не хочет.
все. поправили
этот код выдает обрезок строки вида 01234567. теперь задача что бы выдавалось не по порядку а в такой последовательности- 67452301.
господа помогите. такую беду и в гугле не сьискать

[Proger10]

Всем здрасти.
Чувствую себя нубом от того, что зайдя в опции проекта, который я уже хз сколько делаю, на вкладку version info не смог нажать Include version information in project!!! Она просто не доступна! От чего это может быть?
ЗЫ Раньше делал проект в delphi 2007, а щас в delphi 2010.

[s0l_ir0n]

Всем здрасти.
Чувствую себя нубом от того, что зайдя в опции проекта, который я уже хз сколько делаю, на вкладку version info не смог нажать Include version information in project!!! Она просто не доступна! От чего это может быть?
ЗЫ Раньше делал проект в delphi 2007, а щас в delphi 2010.
попробуй удалить из папки проекта все файлы с расширением dcu, bdsproj, bdsproj.local, identcache, res, dcu, cfg, dof, ~ddp, ~pas, ~dpr, drc

[Proger10]

попробуй удалить из папки проекта все файлы с расширением dcu, bdsproj, bdsproj.local, identcache, res, dcu, cfg, dof, ~ddp, ~pas, ~dpr, drc
не прокатило

[Proger10]

Если ресурс Билдером открыть ресурсный файл, и добавить информацию о версии, откомпилировать, то версия будет.
ЗЫ Иконку тоже нельзя изменить - что-то с ресурсвми. Заменил главный ресурсный файл файлом с чистого проекта - нифига.
ЗЗЫ В проекте используется не один res файл.

[Vasek13]

Помогите решить задачку на паскале
даны действительное число a и натур. число n.Вычислить если n=5
p=a(a+1)...(a+n-1)

[Alk@sh]

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

заранее спс))

[transserg]

Proger10 сделай копию проэкта и удали ресурсный фалй тот что с именем проэкта совпадает при открытии проэкта делви обругает тебе что несмогла найти его и создаст занова=) таккоу бывало когда разные версии среды

[s0l_ir0n]

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

заранее спс))
http://forum.antichat.ru/showpost.php?p=1715554&postcount=19

[alexey-m]

У меня вопрос по прехвату api функций, использовал эту статью
http://www.xakep.ru/post/22263/default.asp

Вызываю замену апи функции на свою(в инжектируемой библиотеке)
InterceptDllCall(hInstance, 'user32.dll', 'MessageBoxA',Pointer(@MyMessageBox), nil, Pointer(myProc));

Вот описание, что бы было понятней


function InterceptDLLCall(hLocalModule: HModule; c_szDllName, c_szApiName:PChar;
pApiNew, pApiToChange: Pointer; var p_pApiOrg: Pointer): boolean;

hLocalModule: HModule; - модуль в котором находиться Import Table
c_szDllName:PChar; - имя DLL, в которой находиться перехватываемая функция
c_szApiName:PChar; - имя перехватываемой функции
pApiNew: Pointer; - указатель на нашу функцию, которая будет вызываться вместо перехватываемой.
pApiToChange: Pointer; - указатель на перехватываемую функцию, если равно nil, то адрес функции определяется через c_szDllName и c_szApiName.
p_pApiOrg: Pointer; - указатель на старую перехватываемую функцию



но проблема вот в чём, замена функции работает только в инжектируемой библиотеке, а не в самом приложении куда я её инжектирую.
Даю гарантию это из за hLocalModule так как hInstance - дескриптор текущего экземпляра приложения, которым является инжектируемая библиотека а не само приложение.
Так как же мне узнать HModule этого приложения?

ZET36 посмотри это, если не читал
[WASM.RU] Цикл статей от Ms-Rem - "Перехват API функций в Windows NT"
http://www.wasm.ru/series.php?sid=8
Есть исходник готовой библы по перехвату и инжекции кода с примерами на delphi, советую почитать кто не видел для расширения кругозора ;)

[Proger10]

попробуй удалить из папки проекта все файлы с расширением dcu, bdsproj, bdsproj.local, identcache, res, dcu, cfg, dof, ~ddp, ~pas, ~dpr, drc
Proger10 сделай копию проэкта и удали ресурсный фалй тот что с именем проэкта совпадает при открытии проэкта делви обругает тебе что несмогла найти его и создаст занова=) таккоу бывало когда разные версии среды
Большое спасибо за помощь! Но все было проше - в исходниках проекта (Client.dpr) было написано:{$R Client.res}, а должно было: {$R *.res}

[StealthMaster]

Помогите решить задачку на паскале
даны действительное число a и натур. число n.Вычислить если n=5
p=a(a+1)...(a+n-1)


program Multiplier;
uses crt;
var
p, a: real;
n: integer;
begin
n := 5;
p := 0;
write('a=');
readln(a);

repeat
inc(n);
p := p*(a+1);
until (n = 0);

writeln ('p=',p);
readln;
end.



Как-то так, если я правильно условие задачи понял)

[ZET36]

alexey-m спасибо, читаю

[xaker-boss]

Видел где-то тут тему, щас не могу её найти.
Вирус, который передает звук с микрафона жертвы, не подскажите где найти.
или с камеры если есть такой?

[h(f)ucker]

поищи в темах slesh'a, он вроде писал

[alexey-m]

Видел где-то тут тему, щас не могу её найти.
Вирус, который передает звук с микрафона жертвы, не подскажите где найти.
или с камеры если есть такой?
на сайте slesh'a смотри http://slesh.name/?act=beta

[SHAXID]

Помогите плз сделать это задание..
Имеется 4 вида фигуры: точка, круг, квадрат и правильный треугольник. Требуется создать программу, которая содержала бы список из выше приведенных фигур и рисовала бы их на экране. Каждый экземпляр какого-либо вида фигуры обладает координатами центра, относительно которого экземпляр будет рисоваться. Если список не пуст, то один элемент списка обязательно должен быть активным, то есть:
1. при отображении он должен каким-либо образом выделяться
2. с данным элементом пользователь может проводить различные операции:
а. удалить
b. подвинуть на экране (влево, вправо, вверх, вниз)
с. повернуть на какой-либо угол (для квадрата и треугольника)
d. изменить размер
e. изменить цвет
Программа должна позволять пользователю выбирать вид фигуры и создавать фигуру текущего вида, которая будет добавляться в список.

[Fireblade]

решил вернуться и повторить пройденое в паскале. Хотел написать элементарный калькулятор, да вылазиет ошибка: "Error in expression"
вот код
program calc;
uses crt;
var a,s,b:integer; c:char;
begin
writeln('введите 1 число');
readln(a);
writeln('введите знак дейчтвия');
readln(c);
writeln('введите 2 число');
readln(b);
case c of
+ : s:=a+b;
- : s:=a-b;
* : s:=a*b;
/ : s:=a/b;
end;
writeln('ответ=',s);
repeat until keypressed;
end.

[total90]

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

[h(f)ucker]

ну символ поидее вот так должен быть '+' '-' '*' '/'
И к чему тут uses crt?

Да И S формат REAL потому что деление

[total90]

И к чему тут uses crt?
каг бэ стандартный модуль иль нет?

[alexey-m]

решил вернуться и повторить пройденое в паскале. Хотел написать элементарный калькулятор, да вылазиет ошибка: "Error in expression"
вот код
program calc;
uses crt;
var a,s,b:integer; c:char;
begin
writeln('введите 1 число');
readln(a);
writeln('введите знак дейчтвия');
readln(c);
writeln('введите 2 число');
readln(b);
case c of
+ : s:=a+b;
- : s:=a-b;
* : s:=a*b;
/ : s:=a/b;
end;
writeln('ответ=',s);
repeat until keypressed;
end.
Вообще то символы в ковычки брать надо
program calc;
uses crt;
var
a,s,b: integer;
c: char;
begin
writeln('введите 1 число');
readln(a);
writeln('введите знак действия');
readln(c);
writeln('введите 2 число');
readln(b);
case c of
'+' : s:=a+b;
'-' : s:=a-b;
'*' : s:=a*b;
'/' : s:=a div b; //s - integer!
end;
writeln('ответ=',s);
repeat until keypressed;
end.

[h(f)ucker]

'/' : s:=a div b; //s - integer!


Это уже не калькулятор получается, точный расчет главное, ну ты понел...

[root_sashok]

repeat until keypressed;

Между repeat и until должно идти тело цикла.

Вот правильный код калькулятора:


program calc; {кстати, program можно и не писать}
uses crt; {это нам для очищения экрана}
label 1; {для перехода к началу}
var a,b:integer; {числа} c:char; {проверка повтора, знака счета}
s:real; {real, т.к присутствует деление}
begin
1: clrscr; {очистка экрана}
writeln('введите 1 число');
readln(a);
writeln('введите 2 число');
readln(b);
writeln('введите знак действия');
readln(c);
case c of {проверка введенного}
'+' : s:=a+b;
'-' : s:=a-b;
'*' : s:=a*b;
'/' : s:=a/b;
end;
writeln('ответ с точностью до двух цифр: ',s:4:2);
{:2 - кол-во цифр после запятой, используется для деления}
writeln ('хотите сосчитать еще раз? Y/N');
readln (c);
if c='Y' then goto 1 {переходим к началу} else
if c='N' then writeln ('для выхода нажмите любую клавишу...');
{просто продолжение}
readln; {ожидание пустого ввода}
end.

[alexey-m]

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

[2kill]

Delphi/Pascal
-----------------------------
на DIV и MOD
Присвоить переменной z первую цифру из дробной части действительного числа r.

я чутка не трезвый и сообразить не могу =(

[utiputi]

и я не трезвый :)
z:=StrToInt(copy(FloatToStr(r),pos(',',FloatToStr( r))+1,1))

[root_sashok]

Значит так, DIV - деление нацело. Для этого переменную типа Real можно и не брать. А вот "/" - это математическое деление, оно требует вещественного типа Real, и, дабы не выводить 100500 знаков после запятой, существует сокращение. Понятно объяснил? И хватит оффтопить в теме.

[denjf]

Подскажите кто работал с потоками в делфи!

на форме есть http1

Сначала делал програму в одном основном потоке

http1.get - работало норм.

Решил переделать программу в 5 потоков

Когда в первом потоке вызваю resp.text:=http1.get('sait.ru');

Компилятор говорит Warring переменая resp может быть не инициализирована.
Маркер указывает на строчку с resp.text:=http1.get('sait.ru');
И все встает колом :(

Посоветуйте по этому поводу что нибуть?

[Пуховой]

form1.resp.text := http1.get ('sait.ru');

А вообще, для каждого потока советую отдельный объект http создавать. Также не забудьте про синхронизацию потоков.

[denjf]

Спасибо Пуховой.

Я так и сделал все заработало норм! ))

[Fireblade]

Спасибо h(f)ucker, alexey-m, root_sashok Забыл что в кавычки надо заключать, а с integer я лажанулся :)

[RobKruzo]

Здравствуйте. В общем у меня к вам просьба о помощи. Сам я не очень ещё и опытен в Delphi, самоучка, учился на электронных учебниках и немного понял основы делфи. Мне в общем нужно сделать проект и я решил написать видеоплеер. Застрял вот на чем:

1) Не могу написать временную шкалу
2) Не получается написать регулировку громкости к проигрывателю
3) Не знаю как сделать полноэкранный режим медиаплеера.

Помогите чем можете, научите дурака :)

[Sams]

Ребята, помогите, все перерыл, нигде не могу найти.
Есть-ли в компоненте IdHTTP какое нибудь свойство, которое определяет, занят в данный момент компонент или нет, ну то есть передает-ли он запрос и ждет ответа, либо уже закончил.
P.S. Знаю, что сам по себе компонент глючный, и winsock лучше, и тем не менее нужен именно данный компонент.

[Nightmarе]

Подскажите, есть ли на Delphi аналог php функции gzdeflate(); ?
То есть у меня огромный текст закодирован в Base64, мне надо его сжать.
Ну а далее чтобы полученный результат можно было раскодировать обычной php функцией gzinflate();
Может модули какие есть или ещё что…

[t04]

Подскажите, есть ли на Delphi аналог php функции gzdeflate(); ?
То есть у меня огромный текст закодирован в Base64, мне надо его сжать.
Ну а далее чтобы полученный результат можно было раскодировать обычной php функцией gzinflate();
Может модули какие есть или ещё что…

посмотри модуль zlib

[=Zeus=]

Подскажите, есть ли на Delphi аналог php функции gzdeflate(); ?
То есть у меня огромный текст закодирован в Base64, мне надо его сжать.
Ну а далее чтобы полученный результат можно было раскодировать обычной php функцией gzinflate();
Может модули какие есть или ещё что…
Хм, а как ты собираешься раскодировать другой функцией, если у zlib свой алгоритм... :confused:
У меня есть пример в нем 2 функции. 1-я принимает параметром поток данных (stream) и сжимает его. Ну и наоборот. Если подходит, могу кинуть. Подходит для сжатия данных любого формата.

[Nightmarе]

Хм, а как ты собираешься раскодировать другой функцией, если у zlib свой алгоритм... :confused:
У меня есть пример в нем 2 функции. 1-я принимает параметром поток данных (stream) и сжимает его. Ну и наоборот. Если подходит, могу кинуть. Подходит для сжатия данных любого формата.
Мне нужно именно для совместимости с php алгоритмами.
То есть получаю данные baze64 сжимаю их в Delphi, отправляю на гейт, а он через gzinflate(); дешифрует информацию.

[t04]

Хм, а как ты собираешься раскодировать другой функцией, если у zlib свой алгоритм... :confused:
У меня есть пример в нем 2 функции. 1-я принимает параметром поток данных (stream) и сжимает его. Ну и наоборот. Если подходит, могу кинуть. Подходит для сжатия данных любого формата.

http://php.su/functions/?cat=zlib
http://php.su/functions/?gzdeflate

gzdeflate это функция из модуля zlib для php, алгоритмы одни и те же (даже в zlib для java micro edition).

[=Zeus=]

http://php.su/functions/?cat=zlib
http://php.su/functions/?gzdeflate

gzdeflate это функция из модуля zlib для php, алгоритмы одни и те же (даже в zlib для java micro edition).
Спасибо, не знал. Тогда Найтмеару подойдет?


uses ZLib;
procedure TForm1.PackStream(Var sSrc: TMemoryStream);
var UnknownPtr: pointer;
NewSize: integer;
begin
sSrc.Position:=0;
try
CompressBuf(sSrc.Memory,sSrc.Size,UnknownPtr,NewSi ze);
sSrc.clear;
sSrc.Write(UnknownPtr^,NewSize);
sSrc.Position:=0;
finally
FreeMem(UnknownPtr,NewSize);
end;
end;

[Flenov]

Всем доброго времени суток!
Задался целью научится работать с ресурсами.
А конкретнее хочу воспроизвести звук из ресурса.
Руководствовался этой (http://www.z-oleg.com/delphi/multim.htm) статьёй.
Как ни крутил нифига не вышло.
Может у кого был опыт в подобном?

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

[h(f)ucker]

2Flenov
Код выложи, и что конкретно не получается?

PlaySound(Pchar('.\sounds\123.wav'),0,SND_ASYNC);
Вот так правильно думаю будет

[Flenov]

Почитай мой пост повнимательней.
Я хочу воспроизвести звук из ресурса.
А ты мне показываешь как из файла.
Я надеюсь, ты знаешь что такое ресурс?

[h(f)ucker]

"Ресурс" - пленка полиэтиленовая, термоусадочная пленка
Are u ponel?
Я тебе пример привел а не сказал как именно сделать, но ещё раз повторю выложи код!

[RobKruzo]

Люди, может мне кто нибудь помочь то??

[Nightmarе]

Спасибо, не знал. Тогда Найтмеару подойдет?


uses ZLib;
procedure TForm1.PackStream(Var sSrc: TMemoryStream);
var UnknownPtr: pointer;
NewSize: integer;
begin
sSrc.Position:=0;
try
CompressBuf(sSrc.Memory,sSrc.Size,UnknownPtr,NewSi ze);
sSrc.clear;
sSrc.Write(UnknownPtr^,NewSize);
sSrc.Position:=0;
finally
FreeMem(UnknownPtr,NewSize);
end;
end;
Почему-то кодирует он в бинарнй код а не в Base64
если можно, покажите пример команды чтобы сжать текст в сжатую Base64 готовую для дешифровки через php функцию

[Flenov]

Ладно.
Всем спасибо за активную помощь по вопросу воспроизведения из ресурса (нихера не помогли)!
Если у кого будет подобная проблемма - почитайте эту (http://www.delphilab.ru/content/view/26/63/) статью.

[seet09]

Народ! У меня ламерский вопрос: как из файла *.pas слудать модуль *.dcu?
Delphi 7

[ZdezBilYa]

Народ! У меня ламерский вопрос: как из файла *.pas слудать модуль *.dcu?
Delphi 7
по идее при компиляции

[0ldbi4]

Я понял о чем ты, зайди в дэлфи создай проект DLL и перетащи туда свой .pas файл потом нажми плэй и готово!

[t04]

Я понял о чем ты, зайди в дэлфи создай проект DLL и перетащи туда свой .pas файл потом нажми плэй и готово!

ты загоняешь. скорее всего у парнишки есть *.pas модуль, но он вне области видимости компилятора, то есть в разделе uses объявлен а в папке проекта его нету. Вот компилятор и ругается что не найден соответствующий *.dcu. Надо просто перетащить *.pas файл в папку с проектом (или в папку C:\Program Files\Borland\Delphi7\Projects\Bpl\) и нажать CTRL+F9, компилятор автоматически сгенерирует dcu из pas и линковщик подключит его к exe.

[Proger10]

Люди, подскажите как в паскале сделать двумерный массив 1000*1000.
var
m: array [1..1000, 1..1000] of byte; Проблема в том, что для размешения в памяти такого массива потредуется больше 64К, ну и паскаль ругается.. Помогите, плиз!

[RumShun]

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

[Proger10]

Пробывал вот так: program Big_Mas;
CONST N1= 1000; N2= 1000;

type M1= array [1..N1 ] of REAL;
M2= array[1..N2] of ^M1;
var a1, a2: M2;
i, j: word;
BEGIN
for i:=1 to N2 do
New(a1[i]);
for i:=1 to N2 do
New(a2[i]);
for j:= 1 to N1 do
for i:= 1 to N2 do
begin
a1[i]^[j]:= j + i*3;
a2[i]^[j]:= j - i*5;
end;
for i:= 1 to N2 do
Dispose(a1[i]);
for i:= 1 to N2 do
Dispose(a2[i]);
Readln;
END.
Вылетает ошибка 203: Heap overflow error! на девятой строке (for i:=1 to N2 do ), а если N1=10, N2=10. То всё норм!

[0ldbi4]

2 t04, парень уже обращался с вопросом, у него сторонняя библиотека без проекта!

[0ldbi4]

Proger10 а тип констант не пробывал указать? и зачем тебе 2 контстанты если матрица квадратная

[transserg]

в какой библиотеке находится компонет TChart?

[Proger10]

Name: TChart
Unit: Chart
Package: dcltee8140

[Proger10]

Proger10 а тип констант не пробывал указать? и зачем тебе 2 контстанты если матрица квадратная
Бесполезно! Пробовал. Дело в том что если значение уменьшаю то все норм!

[Markus_13]

Ребята, помогите, все перерыл, нигде не могу найти.
Есть-ли в компоненте IdHTTP какое нибудь свойство, которое определяет, занят в данный момент компонент или нет, ну то есть передает-ли он запрос и ждет ответа, либо уже закончил.
P.S. Знаю, что сам по себе компонент глючный, и winsock лучше, и тем не менее нужен именно данный компонент.

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

З.Ы. насчет глючности хз - не замечал глюков - все пашет прекрасно =)

[RumShun]

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

[ZdezBilYa]

Proger10, попробуй директиву $M


Размеры распределения памяти.

Синтаксис : {$M stacksize (размер стека), heapmin (минимальный
адрес кучи), heapmax (максимальный адрес кучи)}

По умолчанию : {$ M 16384, 0, 655360}

Тип : глобальный

Эквивалент меню : Options/Memory Sizes

Эта опция задает параметры распределения памяти программ.
Stacksize должен быть целым числом в диапазоне от 1024 до 65520,
которое задает размер сегмента стека. heapmin должен быть в
диапазоне от 0 до 655360, а heapmaх должен быть в диапазоне от
heapmin до 655360. Heapmin и heapmax задают минимальный и
максимальный размер кучи соответственно.
Более подробно сегмент стека и куча описаны в главе 4
"Переменные" и в главе 16 "Память".

[0ldbi4]

Здрасть, забыл какое событие stringrid'а возвращает выделенную ячейку??

[StealthMaster]

Здрасть, забыл какое событие stringrid'а возвращает выделенную ячейку??

У StringGrid'a есть свойство Selection, там хранится информация о выделенном диапозоне: номера левого и правого столбцов, а также верхней и нижней строки.

Если выделена 1 ячейка, то значения StringGrid1.Selection.Left и StringGrid1.Selection.Right совпадают.
Аналогично с StringGrid1.Selection.Top и StringGrid1.Selection.Bottom.


procedure TForm1.Button1Click(Sender: TObject);
var
i, j: integer;
begin
// с учетом того, что в Cells первый индекс закреплен за столбцом
j := StringGrid1.Selection.Left;
i := StringGrid1.Selection.Top;
showmessage('Выделена ячейка [' + IntToStr(j)+ ', ' + IntToStr(i) +
']. Ее значение: ' + StringGrid1.Cells[j, i]);
end;

[StealthMaster]

Вопрос по Delphi 7
Есть абстрактный класс TCrypt и несколько его потомков TVigenereCrypt, TEnigmaCrypt и TAESCrypt.
В каждом из потомков описаны внутренние методы. Можно ли каким-либо способом получить доступ к методам потомков (разумеется к тем, которые не являются реализацией абстрактных методов TCrypt), если переменная описана как
var
Crypt: TCrypt
и при этом используется контруктор одного из потомков класса TCrypt, например, TAESCrypt?

[>>serhio<<]

Можете глянуть две задачки на pascale ?
1)Определить сумму элементов, массива целых чисел размерностью 15, элементов с 1 по 12 и с 8 по 15.И найти произведения этих сумм с использованием функций.
2)Найти min элемент одномерного массива описав процедуры ввода элементов массива, процедура нахождения min элемента массива.

[t04]

1 задача - решил от делать нечего


function multiple(const a,b:Integer):Integer;
begin
result := a*b;
end;

var
A:Array [1..15]of integer;
i,sum1,sum2,mult:integer;
begin

// предполагается что массив уже заполнен
Sum1 := 0;
Sum2 := 0;
for i := 1 to 12 do
Inc(Sum1,a[i]);
for i := 8 to 15 do
Inc(Sum2,a[i]);
mult := multiple(sum1,sum2);
WriteLn(Mult);// Это твой ответ
end;
2 лень чё то стало писать, с такой задачей даже ребенок 3го класса справится, поднапряги мозги.

[SHAXID]

-----

[t04]

меню на VCL или на API?
или надо вообще просто в консоли выбор делать?

[0ldbi4]

2 t04 ты видел в API chаrt? или на консоли?)
Извиняюсь за офтоп, не у кого нет исходничка по решению транспортной задачи методом фогеля?

[SHAXID]

меню на VCL или на API?
или надо вообще просто в консоли выбор делать?

в дельфе усё сие деяние должно творитцо)
p.s ссори, забыл сказать)

[Jerri]

Мне на паскале нужна такая прога:
Вывод одной надписи,и через 15 секунд ещё одной надписи. Как это на паскале реализовать? :(

[Thenno]

Мне на паскале нужна такая прога:
Вывод одной надписи,и через 15 секунд ещё одной надписи. Как это на паскале реализовать? :(
Гуги в сторону модуля CRT и процедуры delay ().

[Jerri]

Гуги в сторону модуля CRT и процедуры delay ().
спс. :)

[yfet]

как отловить капчу контакта?

[SHAXID]

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

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

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

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

- При выборе пункта "сброс", должна очищаться диаграмма (компонент chart) для послед. данных.

з.ы На дельфе это всё делается)

[mr_walker]

Ребята...как реализовать в логе(мемо) сервера(инди ХТТП сервак) чтобы показывалось КТО подключился... я ставлю обработку события ОнКоннект, но не знаю к какому элементу Инди ХТТП сервера обращатся...

[n0th1ng!~]

народ есть exe файл надо поллучить весь его код он на делфи как?

[root_sashok]

народ есть exe файл надо поллучить весь его код он на делфи как?

Ну, насчет всего кода не уверен, а декомпилятор тебе поможет. Скачай это (http://www.runweloads.com/cod/gen/4551prog.html).

[Nightmarе]

У кого нибудь есть нормальный рабочий обусификатор .pas файлов для Delphi ???
Чтобы он шифровал\переименовывал имена функций, процедур, текстовых значений в одинарных ковычках и т.д...
Не могу найти нормального ;(

[Linkus]

Ребята...как реализовать в логе(мемо) сервера(инди ХТТП сервак) чтобы показывалось КТО подключился... я ставлю обработку события ОнКоннект, но не знаю к какому элементу Инди ХТТП сервера обращатся...

в каком плане КТО? IP адрес? имя компьютера, или что ты имеешь в виду?

[Nightmarе]

Напомните плз по поводу парсинга (уже спрашивал но не смог в этой теме найти).

Текст: <lol>ass</lol>
как отпарсить текст между этими двумя тегами? чтобы в итоге было ass.

[slesh]

s := '<lol>ass</lol>';

p := pos('<lol>', s);
if (p > 0) then
begin
p1 := pos('</lol>', s);
if (p1 > 0) and (p1 > p) then data := copy(s, p+5, p1-p-5);
end;

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

[wolmer]

Напомните плз по поводу парсинга (уже спрашивал но не смог в этой теме найти).

Текст: <lol>ass</lol>
как отпарсить текст между этими двумя тегами? чтобы в итоге было ass.
Регуляркой:
procedure TForm1.FormCreate(Sender: TObject);
begin
RegExp:=TRegExpr.Create;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
tag:string;
begin
regexp.expression:='<lol>(.+?)</lol>';
tag:='<lol>Hello world</lol>';
if RegExp.Exec(tag) then showmessage(RegExp.Match[1]);
end;
Где взять RegExp:
http://www.delphisources.ru/files/sources/raznoe/2007_year/regexp_debugger.zip

Вот еще тема которая мне помогла когда то:
http://forum.antichat.ru/threadnav119447-1-10.html

[_s1r1us_]

Как узнать Last Update icq? пнити в нужную сторону))

[mr_walker]

Я уже спрашивал... но...:
Ребята...как реализовать в логе(мемо) сервера(инди ХТТП сервак) чтобы показывалось КТО(АйПи Адрес) подключился... я ставлю обработку события ОнКоннект, но не знаю к какому элементу Инди ХТТП сервера обращатся...

[Linkus]

Я уже спрашивал... но...:
Ребята...как реализовать в логе(мемо) сервера(инди ХТТП сервак) чтобы показывалось КТО(АйПи Адрес) подключился... я ставлю обработку события ОнКоннект, но не знаю к какому элементу Инди ХТТП сервера обращатся...

процедура OnConnect даёт тебе доступ к потоку подключившегося пира под именем AThread:

procedure TForm1.IdHTTPServer1Connect(AThread: TIdPeerThread);

оттуда можно достать его IP адрес:
Memo1.Lines.Add(AThread.Connection.Socket.Binding. PeerIP);

Удачи :)

[Sin3v]

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

[StealthMaster]

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


PROGRAM PMatrix;
uses
Crt;

const
N = 3;

Var
Matrix: Array [1..N,1..N] of byte;
Indexes: set of byte;
counter: byte;

function CheckLine(LineIndex: byte): boolean;
var
i, j: byte;
begin
counter := 0;
CheckLine := false;
for i := 1 to N do
if (Matrix[LineIndex,i] = 0) then
begin
inc(counter);
if counter > 1 then
begin
CheckLine := false;
exit;
end;
if (i in Indexes) then
begin
CheckLine := false;
exit;
end;
end;
CheckLine := true;
end;


procedure GenerateMatrix;
var
tmpindex: byte;
i, j: byte;
begin
Indexes := [];
randomize;

for i := 1 to N do
begin
repeat
tmpindex := random(N)+1;
for j := 1 to N do
if j = tmpindex then
Matrix[i,j] := 0
else
Matrix[i,j] := random(99)+1;
until (CheckLine(i));

Indexes := Indexes + [tmpindex];
end;
end;


procedure ChangeLines(index1, index2: byte);
var
tmp: byte;
i: byte;
begin
for i := 1 to N do
begin
tmp := Matrix[index1,i];
Matrix[index1,i] := Matrix[index2,i];
Matrix[index2,i] := tmp;
end;

end;


procedure SortMatrix;
var
i, j: byte;
begin
for i := 1 to N do
begin
if not(CheckLine(i)) then
exit;
for j := 1 to N do
if (Matrix[i,j] = 0) then
ChangeLines(i,j);
end;
end;


procedure ShowMatrix;
var
i, j: byte;
begin
for i := 1 to N do
begin
for j := 1 to N do
if (Matrix[i,j] < 10) then
write(' ', Matrix[i,j], ' ')
else
write(Matrix[i,j], ' ');
writeln
end;
end;


var
i, j: byte;
choice: char;
begin
clrscr;
write('Would you like to generate the matrix automatically? (y/n)');
readln(choice);
if (choice = 'y') then
GenerateMatrix
else
for i := 1 to N do
for j := 1 to N do
begin
write('Matrix[',i,',',j,'] = ');

readln(Matrix[i,j]);
if (Matrix[i,j] = 0) then
Indexes := Indexes + [j];
end;

writeln;
ShowMatrix;
writeln;
SortMatrix;
ShowMatrix;
readln;
end.



Небольшой комментарий:

размер матрицы задается с помощью константы N. Поскольку есть возможность ручного ввода матрицы, то значение по умолчанию у N небольшое.
GenerateMatrix - заполняет матрицу правильным образом
ChangeLines - меняет 2 строки местами
SortMatrix - упорядочивает строки согласно заданию
ShowMatrix - выводит матрицу на экран
CheckLine - проверяет, нет ли в какой-либо строке или столбце более 1 нуля.

[DiHWO]

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

[StealthMaster]

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

[DiHWO]

тогда другой вопрос, где хранить статьи? в константах? .тхт файлах? переменных?

[StealthMaster]

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

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

[transserg]

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

Procedure GetSystemInformation;
var
Temp: PSYSTEM_MODULE_INFORMATION;
modin:PSYSTEM_MODULE_INFORMATION;
ReturnLength: DWORD;
I: integer;
ou:integer;
begin
ou:=0;
try
ReturnLength := 0;
if NtQuerySystemInformation(SystemModuleInformation,n il, 0, ReturnLength) <> STATUS_INFO_LENGTH_MISMATCH then
Exit;
if ReturnLength > 0 then
begin
GetMem(modin, ReturnLength);
try
if NtQuerySystemInformation(SystemModuleInformation,m odin, ReturnLength, ReturnLength) = 0 then
begin
Temp := modin;
repeat

Form2.ListBox1.Items.Add(Temp^.aSysM.ImageName);
Temp := Pointer(DWORD(Temp) + Temp^.aSysM.ModuleNameOffset);
if Temp^.aSysM.ModuleNameOffset=0 then
inc(ou);

until ou=2;
end;
finally
FreeMem(modin);
end;
end;
finally
end;
end;
SYSTEM_MODULE= ^_SYSTEM_MODULE;
_SYSTEM_MODULE= packed record
Reserved:array[0..1] of ULONG;
Base:ULONG;
Size:ULONG;
Flags:ULONG;
Index:ULONG;
Unknown:ULONG;
ModuleNameOffset:SHORT;
ImageName:Array[0..256] of Char;
end;
PSYSTEM_MODULE_INFORMATION = ^SYSTEM_MODULE_INFORMATION;
SYSTEM_MODULE_INFORMATION = packed record
uCount:ULONG;
aSysM:SYSTEM_MODULE;
end;

уже начался брутвфорс по перебору вариантов но это не дело...

[DiHWO]

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

[Thenno]

StealthMaster, сэнк, вот если хранить в тхт, можно как - то спрятать тхт чтобы программа была одним файлом? просто прогу хочу на школьный конкурс, и какбе прога которая берет все из тхт файлов....ну неочень проффесионально\опрятно чтоли....
Почему неопрятно? Очень даже опрятно. Используй обычные текстовые файлы с собственным расширением. Я бы сделал так - исполнимый файл и рядом папку с базой этих самых файлов. Так будет удобнее и для расширения, и для реализации.
Хотя самое красивое решение - это с базой данных, ИМХО.

[DiHWO]

всем спасибо, буду делать с текстовыми файлами.

[transserg]

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

Procedure GetSystemInformation;
var
Temp: PSYSTEM_MODULE_INFORMATION;
modin:PSYSTEM_MODULE_INFORMATION;
ReturnLength: DWORD;
I: integer;
ou:integer;
begin
ou:=0;
try
ReturnLength := 0;
if NtQuerySystemInformation(SystemModuleInformation,n il, 0, ReturnLength) <> STATUS_INFO_LENGTH_MISMATCH then
Exit;
if ReturnLength > 0 then
begin
GetMem(modin, ReturnLength);
try
if NtQuerySystemInformation(SystemModuleInformation,m odin, ReturnLength, ReturnLength) = 0 then
begin
Temp := modin;
for I := 0 to Temp^.uCount do
// if pos('.dll',String(Temp^.aSysM[i].ImageName))>0 then
Form2.ListBox1.Items.Add(ExtractFileName(Temp^.aSy sM[i].ImageName));
end;
finally
FreeMem(modin);
end;
end;
finally
end;
end;

[transserg]

Pr0mo не мне список драйверов ненужен мне надо именно списко загруженных длл в системе =)

[alwex]

всем привет, помогите решить тупую задачу...
вывести 2 натуральных числа дробь каких наближает число Пи(3.14) с найбольшей точностью на Pascal...

[Jajce]

А как можно перевести эту прогу в графический режим с использованием СтрингГрида?
{$APPTYPE CONSOLE}

type
TMatrix =
record
size: integer;
data: array of array of integer;
end;

var
m: TMatrix;

function Minor(matrix: TMatrix; i,j: integer): TMatrix;
var
a,b,a1,b1: integer;
begin
a1 := -1;
b1 := -1;
result.size := matrix.size - 1;
setlength(result.data, result.size, result.size);
for a := 0 to result.size do
begin
if a=i then
continue
else
inc(a1);
for b := 0 to result.size do
begin
if b = j then
continue
else
if b - b1 > 1 then
inc(b1)
else
b1 := 0;
result.data[a1,b1] := matrix.data[a,b];
end;
end;
end;

function Determ(matrix: TMatrix): integer;
var
i: integer;
begin
result := 0;
if matrix.size = 2 then
result := (matrix.data[0,0]*matrix.data[1,1]) - (matrix.data[0,1]*matrix.data[1,0])
else
begin
for i := 0 to matrix.size - 1 do
if odd(i+1) then
result := result + matrix.data[i,0]*Determ(Minor(matrix,i,0))
else
result := result - matrix.data[i,0]*Determ(Minor(matrix,i,0));
end;
end;

begin
m.size := 3;
setlength(m.data,3,3);
m.data[0,0] := 2;
m.data[0,1] := 4;
m.data[0,2] := -1;
m.data[1,0] := -1;
m.data[1,1] := 3;
m.data[1,2] := 2;
m.data[2,0] := 3;
m.data[2,1] := 2;
m.data[2,2] := -2;
writeln(Determ(m));
readln;
end.
Просто у самого не получается никак :confused:

[FindeR]

Немного не пойму, как обратиться к динамично созданному объекту. А именно, к конкретному событию.
К примеру, создали

Btn : array [0..100] of TButton;
Chk : array [0..100] of TCheckBox;
....
Btn[1] := TButton.create(self);
Chk[1] := TCheckBox.create(self);
Btn[2] := TButton.create(self);
Chk[2] := TCheckBox.create(self);
{и так сотня пар}

Теперь требуется при нажатии Btn[i] менять состояние Chk[i].

Кто подскажет, как реализовать?

[Pr0mo]

Немного не пойму, как обратиться к динамично созданному объекту. А именно, к конкретному событию.
К примеру, создали

Btn : array [0..100] of TButton;
Chk : array [0..100] of TCheckBox;
....
Btn[1] := TButton.create(self);
Chk[1] := TCheckBox.create(self);
Btn[2] := TButton.create(self);
Chk[2] := TCheckBox.create(self);
{и так сотня пар}

Теперь требуется при нажатии Btn[i] менять состояние Chk[i].

Кто подскажет, как реализовать?

Для этого тебе нужно создать свою процедуру, скажем:


...
procedure DynamicChkeBoxChange(Sender:TObject);
...


procedure TForm1.DynamicChkeBoxChange(Sender:TObject);
begin
//Здесь все необходимые операции, например:
chk[1].Checked:=true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Btn[1] := TButton.create(self);
Chk[1] := TCheckBox.create(self);
chk[1].Parent:=Form1;
chk[1].Left:=200;
chk[1].Top:=200;
btn[1].Parent:=form1;
btn[1].OnClick:=TT; // Передаем событие TNotifyEvent
end;


p.s.Есть и более разумнуе способы, но разобраться в них будет сложнее :)

[NTFF]

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

написать нужно в форме процедур

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

Код:

BEGIN
clrscr;
write('Vvedite matrix A: ');
for i:=1 to 5 do
for j:=1 to 5 do
read (A [i,j]);

for i:=1 to 5 do
for etap:=1 to 5 do
if (A[i,etap]=0)
then findrow:=i;
for j:=1 to 5 do
begin
c:=(A[etap,j]);
A[etap,j]:=A[findrow,j];
A[findrow,j]:=c;
write (A[findrow,j]);

[Pr0mo]

Pr0mo не мне список драйверов ненужен мне надо именно списко загруженных длл в системе =)

Извиняюсь, не заметил сначала. Тогда есть вариант обратиться к каждому объекту, вызывающющему dll через его PID и на основе этого построить список загруженных библиотек в системе:


procedure GetAllDLL(var DLLList:TStringList);
var
i:integer;
tList:TStringList;
ArrInfo:TLpModuleInfoArray;
begin
tList:=TStringList.Create;
ArrInfo:=GetAllProcessesInfo(false);
for i:=0 to Length(ArrInfo)-1 do
begin
GetLoadedDLLList(tList,ArrInfo[i].ModulePID,[moIncludeHandle]);
DLLList.AddStrings(tList);
end;
tList.Free;
end;

// пример использования:

procedure TForm1.Button1Click(Sender: TObject);
var
ntDLLList:TStringList;
begin
ntDLLList:=TStringList.Create;
GetAllDLL(ntDLLList);
ListBox1.Items:=ntDLLList;
ntDLLList.Free;
end;


Однако для компиляции тебе понадобиться отдельный модуль : ProcUtilz (скачать) (http://depositfiles.com/files/g82hshua5)

[FindeR]

Для этого тебе нужно создать свою процедуру, скажем:


...
procedure DynamicChkeBoxChange(Sender:TObject);
...


procedure TForm1.DynamicChkeBoxChange(Sender:TObject);
begin
//Здесь все необходимые операции, например:
chk[1].Checked:=true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Btn[1] := TButton.create(self);
Chk[1] := TCheckBox.create(self);
chk[1].Parent:=Form1;
chk[1].Left:=200;
chk[1].Top:=200;
btn[1].Parent:=form1;
btn[1].OnClick:=TT; // Передаем событие TNotifyEvent
end;


p.s.Есть и более разумнуе способы, но разобраться в них будет сложнее :)

И так сотня процедур? Или я что-то недопонял? ;)
Да и неизвестно заранее количество объектов.

[Pr0mo]

И так сотня процедур? Или я что-то недопонял? ;)
Да и неизвестно заранее количество объектов.

Нет, конечно не сотня! Не для каждого же объекта писать отдельную процедуру или функцию. DynamicCheckBoxChange - это общая процедура, в которой можно описать необходимые действия, и затем присваивать ее определенным группам CheсkBox.
А что касается неопределенности количества объектов, то тут прийдется заводить глобальную переменную, например, CheckBoxCount. И ссылаться в будущем на нее.

Вообще говоря, такое динамическое создание объектов - это всегда рутинная, а иногда и бесполезная работа. Однако общий принцип таков.

[FindeR]

Нет, конечно не сотня! Не для каждого же объекта писать отдельную процедуру или функцию. DynamicCheckBoxChange - это общая процедура, в которой можно описать необходимые действия, и затем присваивать ее определенным группам CheсkBox.
А что касается неопределенности количества объектов, то тут прийдется заводить глобальную переменную, например, CheckBoxCount. И ссылаться в будущем на нее.

Вообще говоря, такое динамическое создание объектов - это всегда рутинная, а иногда и бесполезная работа. Однако общий принцип таков.

А именно, как получить передать имя кнопки, которую нажали?
Нажата Btn[1], сменился статус у Chk[1] и т.д.
А не нажата любая Btn, а меняется статус у Chk[1]

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

[Pr0mo]

А именно, как получить передать имя кнопки, которую нажали?
Нажата Btn[1], сменился статус у Chk[1] и т.д.
А не нажата любая Btn, а меняется статус у Chk[1]

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

Тогда немного посложнее. В процедуре нужно ссылаться на указанный объект:


procedure TForm1.DynamicCheckBoxChange(Sender: TObject);
begin
if (sender as TButton).Caption='123' then
chk[1].Checked:=true;
end;


Здесь Sender - это переменная, которая указывает на вызванный объект (нажатая кнопка). Таким образом, если у нажатой кнопки Caption = '123' то выполнится условие chk[1].Checked:=true;

[FindeR]

Тогда немного посложнее. В процедуре нужно ссылаться на указанный объект:


procedure TForm1.DynamicCheckBoxChange(Sender: TObject);
begin
if (sender as TButton).Caption='123' then
chk[1].Checked:=true;
end;


Здесь Sender - это переменная, которая указывает на вызванный объект (нажатая кнопка). Таким образом, если у нажатой кнопки Caption = '123' то выполнится условие chk[1].Checked:=true;

Спасибо. Именно тот пример, что был нужен.

[Thenno]

в каждом столбце и каждой строке матрицы содержица строго по одному нулевому элементу. Перестановкой строк добиться расположение всех нулей по главной диагонали. В программе должна присутствовать проверка чтоб в строке был строго один ноль, в противном случае цикл не выполняться. матрица 5*5 пользователь сам ее вводит
А необходимо переставлять эелементы в строке, или сами строки?

[StealthMaster]

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

Перестановкой строк добиться расположение всех нулей по главной диагонали.


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

Как я понял из сегодняшнего разговора, генерировать матрицу не нужно, а сортировка не выполняется вообще, если есть неправильная строка. Тогда вот код:


PROGRAM PMatrix;
uses
Crt;

const
N = 5;

Var
Matrix: Array [1..N,1..N] of byte;
Indexes: set of byte;
counter: byte;

function CheckMatrix: boolean;
var
i, j: byte;
begin
CheckMatrix := false;
Indexes := [];
for i := 1 to N do
begin
counter := 0;
for j := 1 to N do
begin
if (Matrix[i,j] = 0) then
begin
inc(counter);
if (j in Indexes) then
exit;
Indexes := Indexes + [j];
end;
end;
if (counter <> 1) then
exit;
end;
CheckMatrix := true;
end;


procedure ChangeLines(index1, index2: byte);
var
tmp: byte;
i: byte;
begin
for i := 1 to N do
begin
tmp := Matrix[index1,i];
Matrix[index1,i] := Matrix[index2,i];
Matrix[index2,i] := tmp;
end;

end;


procedure SortMatrix;
var
i, j: byte;
tmp: boolean;
begin
for i := 1 to N do
begin
for j := 1 to N do
if (Matrix[i,j] = 0) then
begin
ChangeLines(i,j);
break;
end;
end;
end;


procedure ShowMatrix;
var
i, j: byte;
begin
for i := 1 to N do
begin
for j := 1 to N do
if (Matrix[i,j] < 10) then
write(' ', Matrix[i,j], ' ')
else
write(Matrix[i,j], ' ');
writeln
end;
end;


var
i, j: byte;
chose: char;
begin
clrscr;
Indexes := [];
for i := 1 to N do
for j := 1 to N do
begin
write('Matrix[',i,',',j,'] = ');
readln(Matrix[i,j]);
end;

writeln;
ShowMatrix;
writeln;

if CheckMatrix then
SortMatrix;

ShowMatrix;
readln;
end.

[Thenno]

Ех, опоздал, но все же выложу и свой вариант.
const n=5;

type
matrix=array[1..n, 1..n] of integer;

procedure readmatrix (var mas:matrix);
var
i,j:integer;
begin
for i:=1 to n do
for j:=1 to n do
readln (mas[i,j]);
end;

function provmatrix (var mas:matrix):boolean;
var
i,j:integer;
k:integer;
begin
provmatrix:=false;
for i:=1 to n do
begin
for j:=1 to n do
begin
if mas [i,j] = 0 then
k:=k+1;
if k>1 then
exit;
end;
k:=0;
end;
provmatrix:=true;
end;

procedure sortmatrix (var mas:matrix);
var
i,j:integer;
index:integer;
mas2:matrix;
begin
for i:=1 to n do
for j:=1 to n do
begin
if mas[j,i]=0 then
begin
for index:=1 to n do
mas2[i,index]:=mas[j,index];
end;
end;
mas:=mas2;
end;

procedure writematrix (mas:matrix);
var
i,j:integer;
begin
writeln;
for i:=1 to n do
begin
for j:=1 to n do
write (mas[i,j], ' ');
writeln;
end;

end;

var
m:matrix;
begin
readmatrix (m);
if provmatrix (m) = true then
begin
sortmatrix (m);
writematrix (m);
end;
readln;
end.

Вроде у StealthMaster'а заморочек побольше, у меня попробще для пониманию новичку, хотя, может быть, я и не прав.

[NTFF]

Ребята большое спасибо!!!!
особенно:
Thenno
и
StealthMaster

[transserg]

как можно замочить зомби процесс если его не берет TerminateProcess с правами отладчика....

[TPAXTOP]

помогите плз....передо мной вот такое задание, а в Паскале - почти 0...(

"Обчислити суму квадратів елементів, значення яких більші, ніж 1."

рус

"Знайти суму квадратов элиментов, значение которых больше, чем 1."

[Thenno]

помогите плз....передо мной вот такое задание, а в Паскале - почти 0...(

"Обчислити суму квадратів елементів, значення яких більші, ніж 1."

рус

"Знайти суму квадратов элиментов, значение которых больше, чем 1."
Как я понял, сумма квадратов это n^2 + (n+1)^2 и так далее.
const
n=3;
var
a,i,k:integer; {если могут быть дробные, то integer меняй на real}
begin
k:=0;
for i:=1 to n do
begin
readln (a);
if a>1 then
k:=k+sqr (a);
end;
writeln ('Sum is ', k);
readln; //для ТурбоПаскаля
end.

P.S А вообще, примеров решения подобных задач полно в Googl'е. И я еще не говорю про учебники.

[coltus]

в паскале нужно удалить из массива (0,2,0,4,0,6...20) нули..

[_nic]

Где метод для рисовки на канву TPanel ????

[Thenno]

в паскале нужно удалить из массива (0,2,0,4,0,6...20) нули..
const n=5;
var
a,b:array[1..n] of integer;
i,index:integer;
begin
index:=1;
for i:=1 to n do
readln (a[i]);
for i:=1 to n do
if a[i]<>0 then
begin
b[index]:=a[i];
index:=index+1;
end;
a:=b;
for i:=1 to index-1 do
write (a[i]);
end.

Люди, юзайте Google хоть для таких-то примеров, там ВСЕ это есть.
P.S Решение, приведенное выше, не самое мега-лучшее, но зато более наглядное, ибо без сильных заморочек.

[balyuk]

Ну тут простенькая задача но я паскаль вабше не знаю )

на дискете свободного места 25процентов
Надо записать 3 файла весом 1.44 Мб
Смогут ли они поместиться?

[ZdezBilYa]

Ну тут простенькая задача но я паскаль вабше не знаю )

на дискете свободного места 25процентов
Надо записать 3 файла весом 1.44 Мб
Смогут ли они поместиться?
причем тут паскаль
объем дискеты - 1.44 Мб. Свободно 25%, значит три файла не поместятся))))

[balyuk]

именно надо на паскале решение написать
и 1.44 Мб. это не обьем дискеты)

[Ponchik]

[20:50:54] <Ponchik> Я делаю tcpclnt1.Receiveln но если нечего читать, прога зависает, как узнать есть чо читать или нет
[20:51:01] <Ponchik> типа как feof в пыхе
хотел нагулить, но гугл feof в какой-то eof переделывает :(

[mailbrush]

eof в дельфи и есть аналог feof в пыхе

[Thenno]

именно надо на паскале решение написать
и 1.44 Мб. это не обьем дискеты)
Эм... А какой тогда объем если не секрет? Или для выполнения задания необходимо применить экстрасенсорные способности?
P.S обычные дискеты (3,5), насколько помню, как раз и были 1,44 МБ (или за ~8 лет мне память совершенно отшибло) -> программа имеет вид.

begin
writeln ('Не поместятся при всем желании несчастного юзера');
end;

[whexp]

Есть разные дискеты с разным объемом. Наиболее популярные - 1.4mb (1440kb).

[Ponchik]

eof в дельфи и есть аналог feof в пыхе
while not Eof(tcpclnt1) do
begin
mmo1.Text := mmo1.Text+#13#10+tcpclnt1.Receiveln;
end;
ему ненравится Eof(tcpclnt1) :o

[whexp]

2Ponchik, eof - символ конца файла, равный какому-либо числу, которое не может представлять другой символ (обычно -1). как ругается Eof()? что есть tcpclnt1? насколько знаю (не знаком с делфи :)) функции должен передаваться дескриптор файла.

[Ponchik]

2Ponchik, eof - символ конца файла, равный какому-либо числу, которое не может представлять другой символ (обычно -1). как ругается Eof()? что есть tcpclnt1? насколько знаю (не знаком с делфи :)) функции должен передаваться дескриптор файла.
tcpclnt1 это открытый порт
мне надо читать чё мне сервер говорит - tcpclnt1.Reciveln Если сервер послал 2 строки, а я захочу прочитать 3 раза tcpclnt1.Reciveln то прога завснет, будет ждать 3 строку, как мне узнать, сколько нужно читать tcpclnt1.Reciveln?

[Pr0mo]

Где метод для рисовки на канву TPanel ????

можно использовать класс TControlCanvas:


procedure TForm1.Button1Click(Sender: TObject);
var
cc: TControlCanvas;
begin
cc := TControlCanvas.Create;
cc.Control := Panel1;
cc.MoveTo(0,0);
cc.LineTo(Panel1.Width,Panel1.Height);
end;



tcpclnt1 это открытый порт
мне надо читать чё мне сервер говорит - tcpclnt1.Reciveln Если сервер послал 2 строки, а я захочу прочитать 3 раза tcpclnt1.Reciveln то прога завснет, будет ждать 3 строку, как мне узнать, сколько нужно читать tcpclnt1.Reciveln?

Не совсем понятно, пытаетесь использовать компоненты или работаете через WinSock?! Как я понимаю, то tcpclnt1 - это компонент типа TidTCPClient? К тому же в качестве аргумента функции EOF () передается файл, а не компонент

[Ponchik]

это TTcpClient ну неважно уже, я уже забил

[mobilka]

подскажите как сделать автопрокрутку в listbox.

[DimkO]

подскажите как сделать автопрокрутку в listbox.
если я правильно понял,то в listbox есть свойство listbox1.ScrollWidth :integer;потом уже сам подгоняеш под длину строки,а вертикальная появляется сама


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

[Thenno]

Есть разные дискеты с разным объемом. Наиболее популярные - 1.4mb (1440kb).
Я это собственно и подразумевал.

[Altairk]

У меня есть вопрос ребята. Как работать с БД в Delphi 2010?

[StealthMaster]

подскажите как сделать автопрокрутку в listbox.

если я правильно понял,то в listbox есть свойство listbox1.ScrollWidth :integer;потом уже сам подгоняеш под длину строки,а вертикальная появляется сама


ScrollWith - это логическая ширина списка, от которой зависит появится горизонтальная полоса прокрутки или нет.

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

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


procedure AddListBoxItem;
var
data: string;
begin
{ здесь производятся нужные действия для формирования строки,
которая будет добавлена }
ListBox1.add(data);
ListBox1.TopIndex := ListBox1.Items.Count -1;
end;


В принципе все прокрутится :) Хотя стоило бы наверное от индекса последней строки отнимать количество отображаемых строк.

[Adalt]

Люди как можно считать текст из односстрочного редактора edit средствами WinApi Пробывал просто GetwindowText(h,buf,255) но не получилось. Подсткажите. И еще вопрос: как можно распознать типа кнопки? делаю getclassname(wnd,op,255); возвращает button на маркеры, чек-кнопки. Надо както распознать.

[StealthMaster]

Люди как можно считать текст из односстрочного редактора edit средствами WinApi Пробывал просто GetwindowText(h,buf,255) но не получилось. Подсткажите.



//text - переменная типа string

SetLength(text, 80);
GetWindowText(edit1.Handle, pansichar(text), 80);


Вроде бы так...

[Adalt]

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

[transserg]

Adalt
поробуй не строку передавать а массив чаров типа

Str:array[0..255] or char;

дожно быть все нормально

[DiHWO]

begin
AssignFile(Text, 'data/text1.txt');
Reset(Text);
while not Eof(Text) do
begin
ReadLn(Text, Data);
Edit1.Text := Data;
end;
CloseFile(Text);
end.

Ошибка в такой легкой задачи... все компилиться, но текст из фпйла не выводит в эдит, хотя текст в файле есть. Что делать?

[TPAXTOP]

Как я понял, сумма квадратов это n^2 + (n+1)^2 и так далее.
const
n=3;
var
a,i,k:integer; {если могут быть дробные, то integer меняй на real}
begin
k:=0;
for i:=1 to n do
begin
readln (a);
if a>1 then
k:=k+sqr (a);
end;
writeln ('Sum is ', k);
readln; //для ТурбоПаскаля
end.

P.S А вообще, примеров решения подобных задач полно в Googl'е. И я еще не говорю про учебники.

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

[TPAXTOP]

Need your help again...
1)Складіть програму для обчислення суми всіх трьохзначних чисел, кратних 25.
rus:Составьте программу для вычисления суммы всех трехзначительных чисел, кратных 25.
2)Для кожного стовпця матриці знайти значення та індекс максимального елемента.
rus:Для каждого столбца матрицы найти значение и индекс максимального элемента.

помогите, плз....

[[Dezzter]]

1)Складіть програму для обчислення суми всіх трьохзначних чисел, кратних 25.
rus:Составьте программу для вычисления суммы всех трехзначительных чисел, кратных 25.

var
a:array[1..1000] of integer;

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
Memo1.Clear;
for i:=1 to 900 do begin
a[i]:=99+i;
Memo1.Lines.Add(IntToStr(a[i]));
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var i,s:integer;
begin
s:=0;
for i:=1 to 900 do begin
if a[i] mod 25=0 then begin
s:=s+a[i];
end;
end;
Label1.Caption:=IntToStr(s);
end;



2)Для кожного стовпця матриці знайти значення та індекс максимального елемента.
rus:Для каждого столбца матрицы найти значение и индекс максимального элемента.
Как понять, для каждого столбца матрици найти значение? Какое значение то ?

[TPAXTOP]

']
var
a:array[1..1000] of integer;

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
Memo1.Clear;
for i:=1 to 900 do begin
a[i]:=99+i;
Memo1.Lines.Add(IntToStr(a[i]));
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var i,s:integer;
begin
s:=0;
for i:=1 to 900 do begin
if a[i] mod 25=0 then begin
s:=s+a[i];
end;
end;
Label1.Caption:=IntToStr(s);
end;




Как понять, для каждого столбца матрици найти значение? Какое значение то ?
Я понятия не имею...это как раз то качество моего препода, которое ненавижу...у него настолько условие задач непонятные, что нереально почти понять что он от тебя хочет...(
ладно, спасибо ОГРОМНОЕ и на этом!

[Adalt]

Adalt
поробуй не строку передавать а массив чаров типа

Str:array[0..255] or char;

дожно быть все нормально

Нет так не получается. Поэтому и написал сюда вот у меня так var buf:array[0..1000] of char;

GetWindowText(wnd, buf, 255);
showmessage(buf);

Этот вариант хорошо подходит в случае, когда у нас имеется button или другие классы. А в случает с Edit совсем е катит. пробывал еще так:
GetDlgItemText(wnd, getwindowlong(wnd,GWL_ID), buf, 255);
Тоже не получается

[Thenno]

']
Как понять, для каждого столбца матрици найти значение? Какое значение то ?

Я так понял, что номер и значение максимального элемента в столбце.

TPAXTOP, лови:

const
n=3;
var
i,j:integer;
a:array[1..n, 1..n] of integer;
max, index:integer;
begin
for i:=1 to n do
for j:=1 to n do
readln (a[i,j]);
for i:=1 to n do
begin
max:=0;
for j:=1 to n do
if a[j,i]>max then
begin
max:=a[j,i];
index:=j;
end;
writeln ('max = ', max, 'index = ', index);
end;
end.
Впринципе, выводит только номер max-элемента в столбце, просто я так понял. Можно организовать выдачу и номера самого столбца, и строки.

[TPAXTOP]

Я так понял, что номер и значение максимального элемента в столбце.

TPAXTOP, лови:

const
n=3;
var
i,j:integer;
a:array[1..n, 1..n] of integer;
max, index:integer;
begin
for i:=1 to n do
for j:=1 to n do
readln (a[i,j]);
for i:=1 to n do
begin
max:=0;
for j:=1 to n do
if a[j,i]>max then
begin
max:=a[j,i];
index:=j;
end;
writeln ('max = ', max, 'index = ', index);
end;
end.
Впринципе, выводит только номер max-элемента в столбце, просто я так понял. Можно организовать выдачу и номера самого столбца, и строки.
да-да, это скорее всего и требовалось. БЛАГОДАРЮ!

[StealthMaster]

begin
AssignFile(Text, 'data/text1.txt');
Reset(Text);
while not Eof(Text) do
begin
ReadLn(Text, Data);
Edit1.Text := Data;
end;
CloseFile(Text);
end.

Ошибка в такой легкой задачи... все компилиться, но текст из фпйла не выводит в эдит, хотя текст в файле есть. Что делать?

Ну после исполнения кода в edit должна вывестись последняя строчка текстового файла. Если в конце файла пустая строка - то в эдите ничего и не будет.

Если нужен весь текст, то попробуй так:

...
ReadLn(Text, Data);
Edit1.Text := Edit1.Text + Data;
...

[DiHWO]

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

begin
Data := 'fgd';
AssignFile(Text, 'data/text1.txt');
Reset(Text);
Edit1.Text := Data;
CloseFile(Text);
end.

Тоже не работает. Это вообще не понятно почему.
------------------------------------------

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Edit1: TEdit;
Text: TextFile;
Data: string;

implementation

{$R *.dfm}

begin
Data := 'fgd';
AssignFile(Text, 'data/text1.txt');
Reset(Text);
Edit1.Text := Data;
CloseFile(Text);
end.

Вот весь код

[StealthMaster]

Не работает...эдит как был пустым так им и остался. В чем проблема я не знаю.


unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Edit1: TEdit;
Text: TextFile;
Data: string;

implementation

{$R *.dfm}

begin
Data := 'fgd';
AssignFile(Text, 'data/text1.txt');
Reset(Text);
Edit1.Text := Data;
CloseFile(Text);
end.

Вот весь код


Ну как бы... У тебя объявлена глобальная переменная Edit1 типа TEdit, при этом нужный тебе edit является полем класса TForm1. И использовать его можно только после создания формы.


unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormShow(Sender: TObject);
var
Text: TextFile;
Data: string;
begin
Data := 'fgd';
AssignFile(Text, 'data/text1.txt');
Reset(Text);
Edit1.Text := Data;
CloseFile(Text);
end.

[Nightmarе]

В Memo лежит такой текст:
58982OBjS9:::random:::random:::
Xr3A2zxtZH:::random::random:::
727GBh11cy:::random:::random:::
5C28wI6S9A:::random:::random:::

Подскажите как сделать поиск, на какой именно линии находится текст (позиция): 727GBh11cy без учёта ::: т д.... и получить номер линии.

[StealthMaster]

function GetIndex(str: string; var Memo: TMemo): integer;
var
i: integer;
begin
Result := 0;
with Memo do
for i := 0 to Lines.Count - 1 do
if (Pos(str, Lines[i]) <> 0) then
begin
Result := i;
exit;
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
str: string;
begin
str := '727GBh11cy';
ShowMessage(IntToStr(GetIndex(str, Memo1)));
end;


Вроде бы так, если я правильно понял суть вопроса...

[DiHWO]

ЖОПА. ничего не работает. и еще почему то нод32 ругаеться, мол вирусы. хотя раньше не ругался, и эдит раньше работал. Кто - нибудь, если не лень, скиньте мне исходник на дельфи с работающим кодом вывода в эдит чего - нибудь. Типо Edit1.Text := '2121'.

[Jajce]

А как можно перевести эту прогу в графический режим с использованием СтрингГрида?
{$APPTYPE CONSOLE}

type
TMatrix =
record
size: integer;
data: array of array of integer;
end;

var
m: TMatrix;

function Minor(matrix: TMatrix; i,j: integer): TMatrix;
var
a,b,a1,b1: integer;
begin
a1 := -1;
b1 := -1;
result.size := matrix.size - 1;
setlength(result.data, result.size, result.size);
for a := 0 to result.size do
begin
if a=i then
continue
else
inc(a1);
for b := 0 to result.size do
begin
if b = j then
continue
else
if b - b1 > 1 then
inc(b1)
else
b1 := 0;
result.data[a1,b1] := matrix.data[a,b];
end;
end;
end;

function Determ(matrix: TMatrix): integer;
var
i: integer;
begin
result := 0;
if matrix.size = 2 then
result := (matrix.data[0,0]*matrix.data[1,1]) - (matrix.data[0,1]*matrix.data[1,0])
else
begin
for i := 0 to matrix.size - 1 do
if odd(i+1) then
result := result + matrix.data[i,0]*Determ(Minor(matrix,i,0))
else
result := result - matrix.data[i,0]*Determ(Minor(matrix,i,0));
end;
end;

begin
m.size := 3;
setlength(m.data,3,3);
m.data[0,0] := 2;
m.data[0,1] := 4;
m.data[0,2] := -1;
m.data[1,0] := -1;
m.data[1,1] := 3;
m.data[1,2] := 2;
m.data[2,0] := 3;
m.data[2,1] := 2;
m.data[2,2] := -2;
writeln(Determ(m));
readln;
end.
Просто у самого не получается никак :confused:
Вопрос снят. Если кому надо обращайтесь в личку

[Nizhegorodets]

Как реализовать работу WebBrowser через прокси?

[HakaR]

Как реализовать работу WebBrowser через прокси?

http://www.delphikingdom.com/asp/answer.asp?IDAnswer=68099

Или в реестре меняй:)

[xtra]

Пользователь вводит элементы списка – целые числа (ввод заканчивается словом end).

как реализовать чтобы паскаль понял слово end?

[total90]

как реализовать чтобы паскаль понял слово end?
прописать end. :D

[xtra]

вопрос снят))

[Seven[up]]

как сделать бы при нажатии на Button1 информация введенная в edit1 и edit2 отправлялась на icq в формате edit1;edit2?

[slesh]

эх... еще один фейк делается ((((
Бери TICQClient и там всё поймеш по примеру

[Seven[up]]

эх... еще один фейк делается ((((
Бери TICQClient и там всё поймеш по примеру
Надо же с чего то начинать :) Чегодня первый день в дельфи, надо как то ознакомиться, фейки поделать :D Спс щас гляну...

[Seven[up]]

где ошибка???
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
ICQClient1: TICQClient;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
ICQClient1.Login;
ICQClient1.SendMessage(361796, Edit1.text+':'+Edit2.text);
ICQClient1.Disconnect;
end;

end.

[HakaR]

']Надо же с чего то начинать :) Чегодня первый день в дельфи, надо как то ознакомиться, фейки поделать :D Спс щас гляну...

Если первый день в дельфи, то нужно с другого начинать. :(

[=Zeus=]

Seven[up], в разделе "Министатьи" я писал пример, как это сделать. Можешь там посмотреть. Там самая последняя на данный момент вроде.

[_s1r1us_]

где ошибка???
номер и пасс забыл ввести))

[Seven[up]]

номер и пасс забыл ввести))
они а настройках компонента ICQClient

[Seven[up]]

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

[crystalbit]

тебе нужно дожидаться. дожидаться, когда ася войдёт. Функция login вроде асинхронно работает. Тут или на OnLogin (или как там), или циклом ждешь LoggedIn (не уверен, как оно в компоненте, но суть ты понял)

[StealthMaster]

']проблему так и не решил((( м.б. кто нибудь подскажет что недостает в коде?


procedure TForm1.bConnectClick(Sender: TObject);
begin
ICQClient1.Login();
end;

procedure TForm1.bSendMessageClick(Sender: TObject);
begin
with ICQClient1 do
if LoggedIn then
SendMessage(361796, edText1.Text + ':' + edText2.Text);
end;


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


procedure TForm1.bConnectClick(Sender: TObject);
begin
ICQClient1.Login();
Timer1.Enabled := true;
end;


procedure TForm1.Timer1Timer(Sender: TObject);
begin
with ICQClient1 do
if LoggedIn then
begin
SendMessage(361796, edText1.Text + ':' + edText2.Text);
Timer1.Enabled := false;
end;
end;


Хотя с компонентом IcqClient чудеса творятся... Днем наотрез отказался подключаться...

[AlexGT]

Народ как в дельфи при достижении прогрессбаром позиции 100 (Progressbar1.Position=100) вывести меседж ?
Перепробовал кучу вариантов, в том числе с таймером ничего не получилось..

[StealthMaster]

Народ как в дельфи при достижении прогрессбаром позиции 100 (Progressbar1.Position=100) вывести меседж ?
Перепробовал кучу вариантов, в том числе с таймером ничего не получилось..

Можно в процедуре, где происходит изменение свойства Position у ProgressBar'a сравнивать новое значение с 100.


procedure SomeThing;
var
Position: integer;
begin
// вычисление нового значения Position
...
form1.Progressbar1.position := Position;
if (Position = 100) then
ShowMessage('lalala');
end;

[Seven[up]]

procedure TForm1.bConnectClick(Sender: TObject);
begin
ICQClient1.Login();
end;

procedure TForm1.bSendMessageClick(Sender: TObject);
begin
with ICQClient1 do
if LoggedIn then
SendMessage(361796, edText1.Text + ':' + edText2.Text);
end;


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


procedure TForm1.bConnectClick(Sender: TObject);
begin
ICQClient1.Login();
Timer1.Enabled := true;
end;


procedure TForm1.Timer1Timer(Sender: TObject);
begin
with ICQClient1 do
if LoggedIn then
begin
SendMessage(361796, edText1.Text + ':' + edText2.Text);
Timer1.Enabled := false;
end;
end;


Хотя с компонентом IcqClient чудеса творятся... Днем наотрез отказался подключаться...
Спасибо ;)

[Uname-A]

Приветствую.

Собственно прошу помочь разобраться с динамической загрузкой дллки bass.dll

До сего дня юзал статический способ(aka простой) но этот способ требовал обязательного наличия дллки рядом с программой Что само по себе мне не подходит

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

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

procedure TForm1.Button1Click(Sender: TObject);
var
BASS_Init : function(device: LongInt; freq, flags: DWORD; win: HWND; clsid: PGUID): Boolean;
BASS_StreamCreateFile : function(mem: BOOL; f: Pointer; offset, length: Int64; flags: DWORD): DWORD;
BASS_ChannelPlay: function(handle: DWORD; restart: BOOL): BOOL;
DLLInstance : THandle;
var stream:TStream;
mem: Pointer;
Channel1:HWND;
begin
stream:=TResourceStream.Create(hinstance,PChar('do orup'),PChar('sounds'));
GetMem(mem, stream.size);
stream.Read(mem^, stream.Size);
DLLInstance := LoadLibrary(PChar('bass.dll'));
if (DLLInstance = 0) then
begin
MessageDlg('Невозможно загрузить DLL', mtError, [mbOK], 0);
Exit;
end;
try
@BASS_Init := GetProcAddress(DLLInstance, 'BASS_Init');
@BASS_StreamCreateFile := GetProcAddress(DLLInstance, 'BASS_StreamCreateFile');
@BASS_ChannelPlay := GetProcAddress(DLLInstance, 'BASS_ChannelPlay');
if Assigned(@BASS_StreamCreateFile) and (Assigned(@BASS_ChannelPlay)) and (Assigned(@BASS_Init)) then
begin
showmessage('uuu');
if BASS_Init(-1, 44100, 0, Application.Handle, nil) then
begin
Channel1:=BASS_StreamCreateFile(true,mem,0,stream. Size,0);
BASS_ChannelPlay(Channel1, true); // timeisout
end;
end
else
MessageDlg('Не найдена искомая процедура!.', mtError,[mbOK], 0);
finally
FreeLibrary(DLLInstance);
end;
end;

ПЫ СЫ: bass.dll версии 2.4, ошибка появляется на строчке которую я выделил Текст ошибки ниже:

---------------------------
Debugger Fault Notification
---------------------------
Project C:\Documents and Settings\Admin\Рабочий стол\Test\Project1.exe faulted with message: 'access violation at 0x0000c35d: read of address 0x0000c35d'. Process Stopped. Use Step or Run to continue.
---------------------------
OK
---------------------------

[neprovad]

подскажите как в delphi узнать что:
1) у устройства, допустим сетевой карты значок желтый в диспетчере устройств, ну который у сбойных устройств появляется или у тех, что не имеют драйверов.
2) как включить\выключить устройство
p.s. подсказки заюзать ту или иную статью msdn также приветствуются

[Uname-A]

подскажите как в delphi узнать что:
2) как включить\выключить устройство
посмотри может поможет.... http://www.cyberguru.ru/programming/delphi/windows-devices-page2.html

[ErrorNeo]

Задача:
требуется прочесть на почтовом ящике заголовки писем, и если есть письмо, содержащее фразу "Hello Vasiliy" - удалить его.

единственный вариант, который пока что увидел -
через POP3 сделать запрос LIST и потом поочередно юзать
RETR 1 - RETR list

Как методами SMTP или же POP3 получить одни лишь заголовки писем?
(не найду нужной команды:( )

[slesh]

Команда POP3 протокола

TOP [сообщение] [количество строк]

Сервер возвращает заголовки указанного сообщения, пустую строку и указанное количество первых строк тела сообщения.
Аргументы
[сообщение] — номер сообщения.
[количество строк] — сколько строк нужно вывести.
Ограничения
Доступна после успешной идентификации.
Возможные ответы
+OK n octets
-ERR no such message

[Uname-A]

у кого есть какие-нибудь идеи насчёт моей проблемы? =)

Все разобрался вроде Я не правильно объявлял функции=)

Вот так это должно выглядеть
procedure TForm1.Button1Click(Sender: TObject);
type
TBASS_Init = function(device: LongInt; freq, flags: DWORD; win: HWND; clsid: PGUID): Boolean; stdcall;
TBASS_StreamCreateFile = function(mem: BOOL; f: Pointer; offset, length: Int64; flags: DWORD): DWORD; stdcall;
TBASS_ChannelPlay = function(handle: DWORD; restart: BOOL): BOOL; stdcall;
var
BASS_Init : TBASS_Init;
BASS_StreamCreateFile : TBASS_StreamCreateFile;
BASS_ChannelPlay: TBASS_ChannelPlay;
DLLInstance : THandle;
stream:TStream;
mem: Pointer;
Channel1:HWND;
begin
stream:=TResourceStream.Create(hinstance,PChar('do orup'),PChar('sounds'));
GetMem(mem, stream.size);
stream.Read(mem^, stream.Size);
DLLInstance := LoadLibrary(PChar('bass.dll'));
if (DLLInstance = 0) then
begin
MessageDlg('Невозможно загрузить DLL', mtError, [mbOK], 0);
Exit;
end;
try
@BASS_Init := GetProcAddress(DLLInstance, 'BASS_Init');
@BASS_StreamCreateFile := GetProcAddress(DLLInstance, 'BASS_StreamCreateFile');
@BASS_ChannelPlay := GetProcAddress(DLLInstance, 'BASS_ChannelPlay');
if Assigned(@BASS_StreamCreateFile) and (Assigned(@BASS_ChannelPlay)) and (Assigned(@BASS_Init)) then
begin
if BASS_Init(-1, 44100, 0, Application.Handle, nil) then
begin
Channel1:=BASS_StreamCreateFile(true,mem,0,stream. Size,0);
showmessage(IntToStr(Channel1));
BASS_ChannelPlay(Channel1, true); // timeisout
end;
end
else
MessageDlg('Не найдена искомая процедура!.', mtError,[mbOK], 0);
finally
// FreeLibrary(DLLInstance); // если не закоментировать то звук воспроизводится рывками
end;
end;

[Vasek13]

Помогите с прогой на паскале, короче через For вот че надо сделать
For: S=1+5+9+...
N=9

Заранее спс

[Thenno]

Помогите с прогой на паскале, короче через For вот че надо сделать
For: S=1+5+9+...
N=9

Заранее спс

const
n=3;
var
i:integer;
k,s:integer;
begin
k:=1;
for i:=1 to n do
begin
s:=s+k;
k:=k+4;
end;
writeln (s);
end.

Элементарно.

[MAESTRO]

const
n=3;

Почему 3, а не 9?Возможно это очепятка=)
И я бы добавил в конце Readln, чтоб все таки результат остался на экране=)

[SinatoR]

народ помогите плиз с пргой на оператор FOR
P=0.1*0.5*0.9...("*" умножить)
N=10

[Vasek13]

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

[MAESTRO]

народ помогите плиз с пргой на оператор FOR
P=0.1*0.5*0.9...("*" умножить)
N=10
Только что пару пастов выше разобран практически такой пример.

[SinatoR]

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

[Vasek13]

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

[MAESTRO]

А посты здесь никто и не набивает, да согласен с тобой, что тема называется: "Задай вопрос, получи ответ", но вы же просите за вас полностью решать и выдавать готовые исходники, ленитесь даже готовый подобный пример переделать.

[TPAXTOP]

парни, помогите...пожалуйста...Турб о Паскаль.
укр)Дано матриці А та В цілих чисел, вивести їх у вигляді масивів. Сформувати та вивести третій масив С згідно умови варіанту:
рус)Даны матрицы А и У целых чисел, вывести их в виде массивов. Сформировать и вывести третий массив С согласно условия варианта:
варіант/вариант:
C=А(в квадрате) + В(в степени T)
Матрица А(m=3,n=3),В(m=3,n=3)
в матрице С обчислить C(минимальное(min))

[StealthMaster]

Хватит оффтопа и флуда!

народ помогите плиз с пргой на оператор FOR
P=0.1*0.5*0.9...("*" умножить)
N=10


PROGRAM FOR_INC;
uses
CRT;
const
n = 10;
var
tmp: real;
result: real;
i: byte;
begin
clrscr;
result := 1;
tmp := 0.1;
for i := 1 to n do
begin
result := result * tmp;
tmp := tmp + 0.4;
end;
writeln('Result: ', result:2:2);
readln;
end.

[DimkO]

парни, помогите...пожалуйста...Турб о Паскаль.
укр)Дано матриці А та В цілих чисел, вивести їх у вигляді масивів. Сформувати та вивести третій масив С згідно умови варіанту:
рус)Даны матрицы А и У целых чисел, вывести их в виде массивов. Сформировать и вывести третий массив С согласно условия варианта:
варіант/вариант:
C=А(в квадрате) + В(в степени T)
Матрица А(m=3,n=3),В(m=3,n=3)
в матрице С обчислить C(минимальное(min))

вот что получилось:
uses crt;
const n=3;
var A,B:array[1..3,1..3] of integer;
C:array[1..3,1..3] of real;
i,j:byte;
t,min:real;
Begin
clrscr;
for i:=1 to n do
for j:=1 to n do
begin
writeln('A',i,j,'=');
readln(A[i,j]);
end;
for i:=1 to n do
for j:=1 to n do
begin
writeln('B',i,j,'=');
readln(B[i,j]);
end;
writeln('T=');
readln(t);
min:=32767;
for i:=1 to n do
begin
for j:=1 to n do
begin
C[i,j]:=sqr(A[i,j])+exp(t*ln(B[i,j]));
if C[i,j]<min then min:=C[i,j];
write(' ',C[i,j]:2:2);
end;
writeln;
end;
writeln('min=',min:2:2);
readln;
End.

PS.знаю что лучше было бы min значение присваивать первому ел матрицы,но в данном случае и так прокатит,просто впадло было еще 1 цикл писать :D

[StealthMaster]

Всем доброго времени суток. Нет ли у кого реализации шифрования текста по алгоритму AES с ключом 128 бит? Желательно с комментариями :rolleyes:

[TPAXTOP]

Складіть програму для обчислення суми всіх трьохзначних чисел, кратних 25.
rus:Составьте программу для вычисления суммы всех трехзначительных чисел, кратных 25.
НА ПАСКАЛЕ,плз.
написали уже раз, но как сказал препод это Дельфи..
помогииите...

[TPAXTOP]

вот что получилось:


PS.знаю что лучше было бы min значение присваивать первому ел матрицы,но в данном случае и так прокатит,просто впадло было еще 1 цикл писать :D
Спасибо, но в 11:04 я уже сидел на информатике без задачи))но ничего, получилось схитрить и по примеру похожей задачи слепил свою, прокатило))

[Thenno]

Складіть програму для обчислення суми всіх трьохзначних чисел, кратних 25.
rus:Составьте программу для вычисления суммы всех трехзначительных чисел, кратных 25.
НА ПАСКАЛЕ,плз.
написали уже раз, но как сказал препод это Дельфи..
помогииите...


program PoraSamomuUchitsya;
var
i,k:integer;
begin
k:=0;
i:=100;
while i<=1000 do
begin
k:=k+i;
i:=i+25;
end;
writeln (k);
end.
Самый оптимальный алгоритм, я думаю.

но ничего, получилось схитрить и по примеру похожей задачи слепил свою, прокатило))

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

[Vish]

program PoraSamomuUchitsya;
var
i,k:integer;
begin
k:=0;
i:=100;
while i<=1000 do
begin
k:=k+i;
i:=i+25;
end;
writeln (k);
end.
Самый оптимальный алгоритм, я думаю.


Ему нужно вообще то, чтобы выводилась сумма элементов делящихся на 25 :)

А ты что сделал? Вот ему писали на делфи https://forum.antichat.ru/showthread.php?p=1753598#post1753598

Вообще не пойму, в чём проблема переделать на паскаль? Делфи это и есть обджек паскаль

Паскаль на компе не стоит, но вот, должно работать:
program PoraSamomuUchitsya;
var
a:array[1..1000] of integer;
i,s:integer;
begin
for i:=1 to 900 do begin
a[i]:=99+i;
if a[i] mod 25=0 then begin
s:=s+a[i];
end;
end;
writeln (s);
end.

[TPAXTOP]

Ему нужно вообще то, чтобы выводилась сумма элементов делящихся на 25 :)

А ты что сделал? Вот ему писали на делфи https://forum.antichat.ru/showthread.php?p=1753598#post1753598

Вообще не пойму, в чём проблема переделать на паскаль? Делфи это и есть обджек паскаль
для тебя может и не проблема, а у нас было пропущено 10 лекций...тоесть было 6 лекций, и 16 лабораторных, кучу всего не объяснили...

[Thenno]

Ему нужно вообще то, чтобы выводилась сумма элементов делящихся на 25 :)

А ты что сделал? Вот ему писали на делфи https://forum.antichat.ru/showthread.php?p=1753598#post1753598

Я ему что требовалось, то и написал. Только в одном месте немного ошибся, признаю.

var
i,k:integer;
begin
k:=0;
i:=100;
while i<=999 do // тут 999, а не 1000, как было
begin
k:=k+i;
i:=i+25;
end;
writeln (k);
end.

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

P.S Мне твой способ кажется каким то... извращенским что ли. Можно проще, без ненужного геморроя с массивами.

var
i:integer;
k:integer;
begin
k:=0;
for i:=100 to 999 do
if i mod 25 = 0 then
k:=k+i;
writeln (k);
end.

[mr_walker]

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

[Vish]

var
i:integer;
k:integer;
begin
k:=0;
for i:=100 to 999 do
if i mod 25 = 0 then
k:=k+i;
writeln (k);
end.


Можно и так, без массива, в принципе так меньше кода) Одно и тоже, ток без массива

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

//хотя наверно я ошибаюсь, потому что в уме начал считать и получается верно) Я сразу и не понял, твоего алгоритма :)

[Thenno]

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

Странно, у меня выдает одно и тоже :)

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

[Vish]

Странно, у меня выдает одно и тоже :)

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

Зато теперь у парня есть несколько вариантов реализации данной ему задачи :rolleyes:

Интересно, что ему препод сказал, когда он принёс задачу написанную на делфи :D

[TPAXTOP]

ну помогите же кто нибудь...
Складіть програму для обчислення суми всіх трьохзначних чисел, кратних 25.
rus:Составьте программу для вычисления суммы всех трехзначительных чисел, кратных 25.
НА ПАСКАЛЕ,плз.

[Vish]

писец, парень не тупи, тебе сделали уже давно.. даже выбор есть, 3 варианта тебе предложено :D