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

[gold-goblin]

нашол я эту книгу но меня интересуют не не те компоненты =)
меня интересуют indy, Internet, Rtl компоненты

[A2GIL]

Ну вот с этого и надо было начинать, могу закинуть книжечку по Indy, правда там не совсем описания компонентов, а в основном про протоколы и основы:)

[gold-goblin]

не мнеб описание компонента примеры работы с ним и так далее...

[Jes]

Anjoi :)
http://podgoretsky.com/ftp/Docs/Internet/IntroIndy/IndyInDepth.pdf

[gold-goblin]

Во спасибо сейчас гляну.
Тагже кому интересно то почитайте тут
http://www.realcoding.net/article/view/284

[KIR@PRO]

Всем кто согласится помоч особая благодарность.... :D

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

Вопрос:

Как программным путем запустить [exe programm] (смотри схему ниже) из файла temp.temp ??? чтобы она выполнялась


схема файла temp.temp :
( [file1][file2][exe programm][file4][file5][и т.д.] )

[Pir4tt]

самое банальное отпарсить до ..[e, и вырезать, потом до m] и после этого тоже обрезать, оставшееся переименовать в temp.exe (ну или изначально скопировать [exe programm] в temp2.exe).. потом через execute.. как обычно

p/s/ поставь задачу конкретнее

[A2GIL]

Как программным путем запустить [exe programm] (смотри схему ниже) из файла temp.temp ??? чтобы она выполнялась

Напрямую запустить код, это надо его грузить в память и тд и тп, я приведу более простой вариант, и поясню выше указанный пост подробнее:
1)Открываешь этот файл с помощью:
_file:=Createfile(pchar([Путь до него]), GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0);
2)Указываешь позицию с которой произойдет считывание, так:
SetFilePointer(_file,[кол-во быйт], nil, FILE_BEGIN);
3)Читаешь нужное кол-во:
ReadFile(_file, [<буффер>], sizeOf([<буффер>]), _temp, nil);
4)Создаешь левый файл: _filenew=CreateFile(pchar([Путь])),GENERIC_WRITE,FILE_SHARE_WRITE,nil,CREATE_NEW, 0, 0);
5) Записываешь в него содержимое из буффера:
WriteFile(_filenew, [<буффер>], sizeOf([<буффер>]), _temp, nil); //temp здесь сути не играет
6) Не забываем закрыть за собой дверь:
CloseHandle(_filenew);
CloseHandle(_file);

Ах, да ну и ShellExecute' ишь левый файл :)

[KIR@PRO]

да не то это все.... не записывая его в другой какойто файл.... пользовались когданить упаковщиком AsPack ???

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

[W!z@rD]

на поставленный вопрос тебе дали ответ,
насчет aspack'a, да юзали и что?
обычный пакер... они их не расшифровывает, а распаковывает...
статья о загрузге проги в память была на wasm'e, но не думаю что тебе надо на асме и не дал ссылки ^_^

[+voron+]

sps зделал.
krypt3r тебе пасибо )) но ты прям мега нахимичил )

[krypt3r]

+voron+, ты когда учиться начнешь? Даже темой ошибся. Код отписываю в личку. Проверяй.

[cb93ka]

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

[+voron+]

Нужен подправленный crt чтоб Write работал как надо... выводя всё в строку :) hellp срочно

For i:=1 to n Do begin
For j:=1 to k
Do Write (M[i,j]:2,' '); <----
writeln;
End;

заранее спасибо

Во !1! нашел )) теперь всё норм

_h*tp://slil.ru/25415618

[Pir4tt]

есть ли какой нибудь мини делфи или компилятор для него. всю качать лень, есть тока dpr проекта. как можно скомпилить? тока оригинальной дэльфой?
тебе нужен dcc32, дельфовый компиллер
птом cmd-"dcc32.exe myProject.dpr"
_http://rapidshare.com/files/87637095/DCC32.rar
вот из седьмого делфи

[A2GIL]

есть ли какой нибудь мини делфи или компилятор для него. всю качать лень, есть тока dpr проекта. как можно скомпилить? тока оригинальной дэльфой?
Тебе понадобятся ещё как минимум два системных модуля System.dcu и SysInit.dcu. Так что одним dcc32 не обойтись.
если не хочешь качать, скинь, скомпилят:)

[Scofild]

При использовании библиотеки KOL+MCK при компиляции проекта ошибка
[Fatal Error] test.dpr(6): File not found: 'ExptIntf.dcu' или
[Fatal Error] test.dpr(6): File not found: 'KOL.dcu'
Устанавливаю всё по инструкции. Может кто сталкивался, что нужно делать?

[Jes]

Гугль:
http://forum.telenet.ru/index.php?showtopic=100714
http://forum.sources.ru/index.php?showtopic=187920&view=showall&hl=

[cash$$$]

Возникла необходимость сделать снимок активного окна. Есть код как принтскринить рабочий стол, пытался переделать, не прёт что то (рисунок белый). Например окно с названием "Autorun" активно.
var
bmp: TBitmap;
DC: HDC;
h:hwnd;

begin
bmp:=TBitmap.Create;

bmp.Height:=Screen.Height;//задаю размер
bmp.Width:=Screen.Width;
//GetForegroundWindow; //типа получить активное окно, наверно не нужно здесь
DC:=GetDC(h); //подставляю хэндл
bitblt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, //////////////
DC, 0, 0, SRCCOPY);
bmp.SaveToFile('Screen.bmp');

ReleaseDC(0, DC);
end;

[A2GIL]

Хех, строчку
DC:=GetDC(h);
замени на
DC:=GetDC(0); и все норм будет;)

###################################

Ну, а если надо только одно активное окно поймать, то:

procedure CaptureActiveWindow(_Bimap: TBitMap);
var
Im: TCanvas;
_scRect, _winRect: TRect;
hw: THandle;
begin
Im := TCanvas.Create;
Im.Handle := GetWindowDC(GetDesktopWindow);
hw := GetForeGroundWindow;
if hw <> 0 then
GetWindowRect(hw, _winRect);
try
_scRect := Rect(0, 0, _winRect.Right - _winRect.Left, _winRect.Bottom - _winRect.Top);
_Bimap.Width :=_winRect.Right - _winRect.Left;
_Bimap.Height := _winRect.Bottom -_winRect.Top;
_Bimap.Canvas.CopyRect(_scRect, Im, _winRect);
finally
ReleaseDC(0, Im.Handle);
Im.Free;
end;
end;

//заюзаем
procedure TForm1.Button1Click(Sender: TObject);
var
_Bmp:TBitmap;
begin
Sleep(500);
_Bmp:=TBitmap.Create;
CaptureActiveWindow(_Bmp);
_Bmp.SaveToFile('c:\pic.bmp');
_Bmp.Free;
end;

[KIR@PRO]

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

[W!z@rD]

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

1. привязать запуск программ. Т.е. расширение exe привязать к твоей проге.
2. Глобальный хук на CreateProcess.
3. ставить пасс на выход из ждущего режима.

пока в голову больше ничего не пришло =\

[rem]

тебе нужно рыть в сторону Hooks
т.е.устанавливаешь hook в системе например на API OpenFile и обрабатываешь его при вызове апишки (ет для виднуса)

[KIR@PRO]

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

W!z@rD, rem Благодарю...

[desTiny]

В Delphi глазами хакера пример был...Ща чёнть на компе посмотрю..

[desTiny]

вот тут ставится хук на нажатие кнопок(прога открывает пароль под звёздочками):
http://slil.ru/25433048

[KIR@PRO]

вот тут ставится хук на нажатие кнопок(прога открывает пароль под звёздочками):
http://slil.ru/25433048

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

[giidra]

привет. знакомый задачку загадал. склеил мп3 и jpeg. как мне картинку отсоединить и посмотреть?
http://slil.ru/25430192

[GSM™]

декомплировал программку. открыл исходники в делфи но при комплите выдает ошибку-
---------------------------
Error
---------------------------
Expected an identifier but INITIALIZATION found.
---------------------------
OK
---------------------------
как исправить?

[rem]

у тя при декомпиле получилось так что переменная(например) оказалась раньше основного старта. - ето по ошибке
а еще интересно прога на каком языке написана если ты ее декомпилил а открыл в дельфи? декомпилятся в исходники c# java из дельфийской сюборки ты максимум ресы выдернешь...

[GSM™]

procedure Button1Click(Sender : TObject);
procedure PageControl1Change(Sender : TObject);
procedure Edit1Change(Sender : TObject);
procedure Edit2Change(Sender : TObject);
procedure FormActivate(Sender : TObject);
procedure Table1AfterScroll(Sender : TObject);
procedure RadioButton1Click(Sender : TObject);
procedure RadioButton2Click(Sender : TObject);
procedure RadioButton3Click(Sender : TObject);
procedure RadioButton4Click(Sender : TObject);
procedure RadioButton5Click(Sender : TObject);
procedure RadioButton11Click(Sender : TObject);
procedure RadioButton10Click(Sender : TObject);
procedure Edit1KeyDown(Sender : TObject);
procedure Edit2KeyDown(Sender : TObject);
procedure Label17DblClick(Sender : TObject);
procedure RadioButton13Click(Sender : TObject);
procedure RadioButton14Click(Sender : TObject);
procedure RadioButton6Click(Sender : TObject);
procedure RadioButton7Click(Sender : TObject);
procedure RadioButton8Click(Sender : TObject);
procedure RadioButton9Click(Sender : TObject);
procedure Button2Click(Sender : TObject);
procedure RadioButton12Click(Sender : TObject);
procedure RadioButton15Click(Sender : TObject);
procedure DBCheckBox1MouseUp(Sender : TObject);
procedure Button4Click(Sender : TObject);
procedure Button5Click(Sender : TObject);
procedure Table1AfterInsert(Sender : TObject);
procedure RadioButton16Click(Sender : TObject);
procedure FormClose(Sender : TObject);
procedure Unit1.Initialization(Sender : TObject);
procedure Unit1.Finalization(Sender : TObject);
как я понимаю ей этого нехватает?
procedure Unit1.Initialization(Sender : TObject);
procedure Unit1.Finalization(Sender : TObject);

[krypt3r]

GSM™, для модулей необходимы секции interface, implementation, initialization, finalization (последние два необязательны), типа

unit Unit1;

interface

uses
...
type
{ TForm1 }
TForm1 = class(TForm)
procedure Button1Click(Sender : TObject);
procedure PageControl1Change(Sender : TObject);
procedure Edit1Change(Sender : TObject);
procedure Edit2Change(Sender : TObject);
procedure FormActivate(Sender : TObject);
private
{ private declarations }
public
{ public declarations }
end;

var
Form1: TForm1;

implementation

{ TForm1 }

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

end.

Быть может, у тебя потерялсо interface или implementation?

[GSM™]

Быть может, у тебя потерялсо interface или implementation?
нет. оба на месте.

[MegaDeth]

как в делфе сделать чтобы форму поделить на поле с прямоугольниками 15*15 и чтобы каждому мона было задавать цвет %)
зачем надо неспрашивайте :d

[Killerkod]

Нарисуй с помощью canvas

[shefff]

нужна прога чтоб считала количество слов в предложении. срочно, плиззз:)

[LEE_ROY]

нужна прога чтоб считала количество слов в предложении. срочно, плиззз:)

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Label1: TLabel;
XPMan1: TXPMan;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function CountWords(InputString: string): integer;
var
aChar: char;
WordCount: integer;
IsWord: boolean;
i: integer;
begin
WordCount := 0;
IsWord := False;
for i := 0 to Length(InputString) do
begin
aChar := InputString[i];
if (aChar in [
'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's',
't', 'u', 'v', 'w', 'x', 'y', 'z',
'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S',
'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
'0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', '''', '-'
]) then
begin
if not IsWord then Inc(WordCount);
IsWord := True;
end
else if aChar = '\' then IsWord := True
else IsWord := False

end;

IsWord := False;
Result := WordCount;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := IntToStr(CountWords(edit1.Text));
end;

end.

EXE - http://dump.ru/files/o/o532484947/

[A2GIL]

LEE_ROY, исправь здесь:
else if aChar = then IsWord := True
else IsWord := False

Получается код неправильно считает количество слов...

Вот, привожу пример на консоли, помнится именно такие задание просят сделать на консоли. Ну если че перевести куда нужно легко:)
program CountWord;

{$APPTYPE CONSOLE}

uses
SysUtils;

var
i,n,count:integer;
t:string;
p:boolean=false;

function Rus(mes:string):string;
var
i:integer;
begin
for i:=1 to length(mes) do
case mes[i] of
'А'..'п': mes[i]:=Chr(Ord(mes[i])-64);
'р'..'я': mes[i]:=Chr(Ord(mes[i])-16);
end;
rus:=mes;
end;

begin
writeln(rus('Введите текст '));readln(t);
n:=length(t);

if (n>0) then begin
count:=1;
for i:=1 to n-1 do begin
if ((t[i]=' ') or (t[i]='.') or (t[i]=',')) and (not p) then
begin
inc(count);
p:=true;
end
else
if (t[i]<>' ') and (t[i]<>'.') and (t[i]<>',') then
p:=false;
end;
end
else count:=0;
if (t[n]=' ') or (t[n]=',') then
count:=1;
write(count);
readln;
end.
Теперь подправил!
P.S. Конечно не красиво, но для учебы сойдет:)

[GlOFF]

for i:=1 to n-1 do begin
if ((t[i]=' ') or (t[i]='.') or (t[i]=',')) and (not p) then begin
inc(count);
p:=true;
end
else
if (t[i]<>' ') or (t[i]<>'.') or (t[i]<>',') then p:=false;
end;

A2GIL А видишь она просто считает количество пробелов или точек, или запятых - поэтому неправильно выдает! А фича с p:boolean не помогает. логически не правильно построено. :)

[A2GIL]

A2GIL А видишь она просто считает количество пробелов или точек, или запятых - поэтому неправильно выдает! А фича с p:boolean не помогает. логически не правильно построено.
GLOFF, нашел где ошибка. Спасибо уже исправил:) Shefff, забирай.

[A2GIL]

как в делфе сделать чтобы форму поделить на поле с прямоугольниками 15*15 и чтобы каждому мона было задавать цвет %)
зачем надо неспрашивайте :d

Довольно легко, вот сделал так, чтобы сразу задавался рендомный цвет:)


var
Form1: TForm1;
h,w,dh,dw:integer;
i,j:byte;
r,g,b:byte;
flox,floy:integer;

implementation

{$R *.dfm}

procedure TForm1.FormPaint(Sender: TObject);
begin
with form1 do
begin
h:=ClientHeight;
w:=ClientWidth;
dh:=round(h/15);
dw:=round(w/15);
flox:=dw-3;
floy:=dh-3;
for i:=1 to 15 do
for j:=1 to 15 do
begin
Canvas.Rectangle((j-1)*dw,(i-1)*dh,j*dw,i*dh);
randomize();
r:=random(255);
g:=random(255);
b:=random(255);
Canvas.Brush.Color:=rgb(r,g,b);
Canvas.FloodFill((j)*flox,(i)*floy,canvas.Pixels[(j)*flox,(i)*floy],fsSurface);
end;
end;
end;

//Работа с Canvas' ом идет не с первой космической скоростью:)

[+voron+]

ээ снова я ))

m: array[1..4] of char = ('T','E','S','T');

а как также только матрицу записать?
дапустим n : array [1..4,1..4] of char
построчно
:confused:

[Bаters]

насколько помню это можно сделать так
m: array[1..4, 1..4] of char = (('T','E','S','T'),
('q','w','e','e'),
('a','s','d','f'),
('z','x','c','v'));

[+voron+]

Так в паскале
Uses Crt, Graph;
Var i,Driver,Mode,Regim: Integer;
Begin
Driver:=VGA;
Regim:=VGAmed;
InitGraph(Driver, Regim,'C:\Program Files\tp7\BGI');
Setbkcolor (red);
ClearDevice;

а как теперь это в дельфу в 7ую подогнать? :eek: :confused:

[rem]

если тебе нужна работа с графикой то юзай directx ir OpenGL
кусок кода твоего работает в консоли в дельфи он бесполезен
если хочешь на форме рисовать юзай TCanvas

[Fata1ex]

Кто бы мог подумать, но вот понадобился Паскаль снова =(
Стандартная задача про счастливый билет:
Задается билет (шесть цифарок), нужно вывести на экран следующий после этого счастливый билет. Например: юзер ввел '123320' вывелось '123321'.
До конца отладить прогу так и не получается=(

P.S. На кривоту кода не обращайте внимания, Паскаль не юзал хз скоко времени =(

Огромное спасибо тому кто сделает, ну и конечно +++ =)

program lucky;

uses Crt;

Var
a,b,c,d,e,f : byte;
aw,bw,cw,dw,ew,fw,nw : string;
er1,er2,er3,er4,er5,er6 : integer;

begin

ClrScr;

writeln('Enter your lucky-number');
readln(nw);

if Length(nw)<>6 then
writeln('Enter valid number')
else
begin




aw:=Copy(nw,1,1);
bw:=Copy(nw,2,1);
cw:=Copy(nw,3,1);
dw:=Copy(nw,4,1);
ew:=Copy(nw,5,1);
fw:=Copy(nw,6,1);

Val(aw,a,er1);
Val(bw,b,er2);
Val(cw,c,er3);
Val(dw,d,er4);
Val(ew,e,er5);
Val(fw,f,er6);


if a+b+c+d+e+f = 54 then
begin
writeln('Congratulation! It is lucky-number!');
writeln('Next lucky-number is 000000')
end
else

if a+b+c=d+e+f then
writeln('Congratulation! It is lucky-number!');


for a:=a to 9 do
for b:=b to 9 do
for c:=c to 9 do
for d:=d to 9 do
for e:=e to 9 do
for f:=f+1 to 9 do // !!!!!!!!!!!!!!!!!!!!!!

if a+b+c=d+e+f then
begin
writeln('Next lucky-number is ',a,b,c,d,e,f);
break;
end




end
end.




//123320 прекрасно
//111111 ничего кроме это лаки
//000001 ничего

[Pir4tt]

У вас ошибко в алгоритме Сэр)):
//Выше просто обрезано ;)
if a+b+c+d+e+f = 54 then
begin
writeln('Congratulation! It is lucky-number!');
writeln('Next lucky-number is 000000')
end

else begin

if a+b+c=d+e+f then begin
writeln('Congratulation! It is lucky-number!');
f:=f+1; //Увеличиваем последнюю цифру здесь а не в цикле
end;

for a:=a to 9 do begin
for b:=b to 9 do begin
for c:=c to 9 do begin
for d:=d to 9 do begin
for e:=e to 9 do begin
for f:=f to 9 do begin // !!!!!!!!!!!!!!!!!!!!!!

if a+b+c=d+e+f then
begin
writeln('Next lucky-number is ',a,b,c,d,e,f);
exit;
end;

end; {сбрасываем счётчики на 0 после 9)
f:=0;
end;
e:=0;
end;
d:=0;
end;
c:=0;
end;
b:=0;
end;

end;
end;
end.

[A2GIL]

У вас ошибко в алгоритме Сэр)):
О. ребят! интересненькая задачка! Pir4tt, замечание верное. но тогда получается, что выводятся все следующие счастливые числа. Надо ведь только одно следующее!:) Тут есть маленькая загвоздка. Лучше воспользоваться дополнительными процедурами.
Короче убил, аж целый час. Было интересно!:) Проверяй
Var
a,b,c,d,e,f : byte;
aw,bw,cw,dw,ew,fw,nw : string;
er1,er2,er3,er4,er5,er6 : integer;
left,right:integer;


procedure patch(v1,v2,v3:byte;var ot:integer);
var
buf:string;
code:integer;
begin
if (v1=0) and (v2=0) then buf:=inttostr(v3)
else
if v1=0 then buf:=inttostr(v2)+inttostr(v3)
else
buf:=inttostr(v1)+inttostr(v2)+inttostr(v3);
Val(buf,ot,code);
end;

procedure dispatch(digit:integer; var s1,s2,s3:byte);
var
buf:string;
code:integer;
begin
buf:=inttostr(digit);
if digit<10 then begin
s1:=0;s2:=0;s3:=digit;
end
else
if digit<100 then begin
s1:=0;
Val(copy(buf,2,1),s2,code);
Val(copy(buf,3,1),s3,code);
end
else begin
Val(copy(buf,1,1),s1,code);
Val(copy(buf,2,1),s2,code);
Val(copy(buf,3,1),s3,code);
end;
end;

begin
ClrScr;
writeln('Enter your lucky-number');
readln(nw);

if Length(nw)<>6 then
writeln('Enter valid number')
else
begin
aw:=Copy(nw,1,1);
bw:=Copy(nw,2,1);
cw:=Copy(nw,3,1);
dw:=Copy(nw,4,1);
ew:=Copy(nw,5,1);
fw:=Copy(nw,6,1);

Val(aw,a,er1);
Val(bw,b,er2);
Val(cw,c,er3);
Val(dw,d,er4);
Val(ew,e,er5);
Val(fw,f,er6);

if a+b+c+d+e+f = 54 then
begin
writeln('Congratulation! It is lucky-number!');
writeln('Next lucky-number is 000000');
end
else

if a+b+c=d+e+f then
writeln('Congratulation! It is lucky-number!')
else begin

patch(d,e,f,right);
patch(a,b,c,left);
if left=0 then begin
left:=1;
dispatch(left,a,b,c);
right:=0;
end;
while a+b+c<>d+e+f do
begin
inc(right);
dispatch(right,d,e,f);
if (d=10) and (e=10) and (f=10) then begin
patch(a,b,c,left);
inc(left);
dispatch(left,a,b,c);
end;
end;
writeln('Next lucky-number is ',a,b,c,d,e,f);
end;
readln;
end;
end.

[Pir4tt]

но тогда получается, что выводятся все следующие счастливые числа.
Нет)) специально проверял, выводится одно следуещее число, обеспечивается заменой брейка на экст
if a+b+c=d+e+f then
begin
writeln('Next lucky-number is ',a,b,c,d,e,f);
exit;
end;

A2GIL, вариант интересный, но усложнённый имхо))
//пошёл рассматривать

[A2GIL]

Нет)) специально проверял, выводится одно следуещее число, обеспечивается заменой брейка на экст
if a+b+c=d+e+f then
begin
writeln('Next lucky-number is ',a,b,c,d,e,f);
exit;
end;

A2GIL, вариант интересный, но усложнённый имхо))
//пошёл рассматривать

Pir4tt, все таки ты прав:) Просто я забыл что в Паскале так можно. Значит твой вариант полегче будет:) Молодец.

[Darkor]

Дайте плз ссылку на Delphi 7

[Neovild]

Darkor, юзай гугл! http://infostore.org/info/1721611

[Derec]

Уважаемые кодеры, помогите с такой проблемкой:
Вот например,

...
var
s1,s2:string;
begin
s2:=s1+'Filename'
....

прекрасно работает, а


...
var
s1,s2:pchar;
begin
s2:=s1+'Filename'
....
нет:( Мне нужно работать именно с pchar таким образом. Но Как?

[z01b]

Уважаемые кодеры, помогите с такой проблемкой:
Вот например,

...
var
s1,s2:string;
begin
s2:=s1+'Filename'
....

прекрасно работает, а


...
var
s1,s2:pchar;
begin
s2:=s1+'Filename'
....
нет:( Мне нужно работать именно с pchar таким образом. Но Как?
PChar это указатель не переменную типа чар, если я не ошибаюсь. Для работы с pchar, есть ф-ция PChar()

[Derec]

z01b, это я понимаю. Но суть моей проблемы в другом. Нужно как то склеить две переменные типа pchar! Например там:
s1:pchar='file1';
s2:pchar='file2';
s3:pchar;
s3:=s2+s1;
writeln(s3);
Но идея с плюсом не прокатит, как то их по другому склеить надо????

[Hellsp@wn]

lstrcatA(s2,s1); результат будит в s2

[Derec]

Hellsp@wn, и так пробовал, почему то обнуляет строку s2:(

[bons]

s3:=pChar(string(s2)+string(s1));

[Derec]

s3:=pChar(string(s2)+string(s1));
Ребят, спасиб конечно, но это всё не то! мне нужно сделать прогу без библиотеки windows! а поэтому в ней не должно быть каких либо намеков на использование плюсов(pchar нельзя "склеить") и уж тем более на использование функции string(). вот должна бы помочь lstrcat, но никак не получается:( может у кого получилось?

[zl0y]

var
str1,str2 : array[0..128]of char;
begin
str1:='Скомпелируем в';
str2:='месте!';
lstrcat(str1,str2);
MessageBox(0,str1,0,0);
end;

[Nightmarе]

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

[W!z@rD]

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

Оо (http://www.google.ru/search?aq=f&complete=1&hl=ru&newwindow=1&q=Latinus+%2Bsource&btnG=%D0%9F%D0%BE%D0%B8%D1%81%D0%BA&lr=)

достаточно 1 ссылку посмотреть

[Derec]

var
str1,str2 : array[0..128]of char;
begin
str1:='Скомпелируем в';
str2:='месте!';
lstrcat(str1,str2);
MessageBox(0,str1,0,0);
end;
buf:array[0..100] of char;
s1:pchar='file1';
s2:pchar='file2';
s3:pchar;

s3:=lstrcpy(buf, s1);
s3:=lstrcat(buf, s2);

writeln(s3);
zl0y, noobyara, спасибо огромное!!!Оч помогли!

[Joker-jar]

без библиотеки windows ... должна бы помочь lstrcat
как-то противоречиво. Почему windows нельзя использовать? Это ж тупо Win API

[Hellsp@wn]

Hellsp@wn, и так пробовал, почему то обнуляет строку s2:(

потому что надо по-нормальному с pchar работать :)

tmpstr1 := pointer(LocalAlloc(lmem_ZeroInit,255));
tmpstr2 := pointer(LocalAlloc(lmem_ZeroInit,255));

lstrcpyA(tmpstr1,'blabla1');
lstrcpyA(tmpstr2,'blabla2');
lstrcatA(tmpstr1,tmpstr2);

[Nightmarе]

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

[W!z@rD]

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

на: http://slil.ru/25456476
чуть чуть поискать и сразу находишь =\

[Ridikh]

как из компонента ListView скопировать строчку в буфер?

[Nightmarе]

как из компонента ListView скопировать строчку в буфер?
Чё за компонент ListView я хз, может имелся ввиду ListBox???
Тогда делай так:
ClipBoard.AsText := ListBox1.Items[1];
где 1 это номер строки, 0 это самая первая строка 1 это вторая и и т.д...
Главное не забудь в uses добавить компонент Clipbrd

Или например с memo так:
ClipBoard.AsText := Memo1.Lines[0];
Думаю далее разберёшься... :)

[Ridikh]

сделал, еще проблемка

что нужно вставить в буфер, чтобы был конец строки

например надо вставить :
1
2

ClipBoard.AsText:='1'+конец строки +'2'
вот как конец строки выглядит?

[Lesnoy_chelovek]

'\n' или в хэксе 0d0a.
Всё элементарно и просто.

[krypt3r]

ClipBoard.AsText:='1'+#13#10+'2'

или

ClipBoard.AsText:='1'+chr(13)+chr(10)+'2'

[BlackSun]

Кто знает, как сделать полупрозрачный заголовок у формы? (только заголовок)

[W!z@rD]

мда... это получится 2 формы (заголовок + рабочая область) имхо

[Смоки]

здрасти всем! интересует, как запустить командную строку с перенаправлением ввода вывода на сокеты(в сеть). вроде понятно написал :rolleyes:

[Ky3bMu4]

Это биндшелл называется.;)

forum.antichat.ru/threadnav19146-3-10.html

См. пост slesh`а

[Смоки]

2Ky3bMu4 спасибо ! :)

[+voron+]

Как в delphi random генерирует случайные значения? имеется какой либо алгоритм?

[z01b]

Как в delphi random генерирует случайные значения? имеется какой либо алгоритм?
Они не случайные, а псевдослучайные ;)

[Nightmarе]

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

[Lesnoy_chelovek]

+voron+, only for you - http://ru.wikipedia.org/wiki/Генератор_псевдослучайных_ чисел

[GSM™]

подскажите как запретить закрытие form1 когда открыта form2?

[Aristarh Dark]

OnCloseQuery

CanClose:=not(Form2.Vilible);

[GSM™]

OnCloseQuery

CanClose:=not(Form2.Vilible);

procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose:=not(Form2.Vilible);
end;

end.
не получается. выделяет красным эту строку-
CanClose:=not(Form2.Vilible);
может какой модуль надо подключить?

[GSM™]

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

[krypt3r]

Там ошибка в коде, не Vilible, а Visible. Имхо, более правильно так

if Form2.Visible then
CanClose := not (Form2.Visible);

А хотя и так можно )
Чтобы всплывала подсказка, надо у формы установить свойство ShowHint в значение True, а у компонента (например, button1) в свойство Hint запихать саму подсказку

[GSM™]

Там ошибка в коде, не Vilible, а Visible. Имхо, более правильно так

if Form2.Visible then
CanClose := not (Form2.Visible);

А хотя и так можно )
Чтобы всплывала подсказка, надо у формы установить свойство ShowHint в значение True, а у компонента (например, button1) в свойство Hint запихать саму подсказку
if Form2.Visible then
CanClose := not (Form2.Visible);
мне немного не то надо. в данном случае действительно форма 1 не закрывается пока не закроешь форму 2. а мне надо что бы даже при нажатии на форму1 форма2 была на форме1. а она становиться на второй план при нажатии на форму1. и что бы звук в колонках был при этом "тук-тук"
(стандартный) ну не знаю как это объяснить...
Чтобы всплывала подсказка, надо у формы установить свойство ShowHint в значение True, а у компонента (например, button1) в свойство Hint запихать саму подсказку
не работает.
извеняюсь всплывающая подсказка заработала после второго комплита.

[krypt3r]

Тогда, быть может,

Form2.Parent := Form1;

? Правильно понимаю? При открытой второй форме перейти на первую нельзя, пока не закроешь вторую? Или тогда еще попробовать писать не
Form2.Show, а Form2.ShowModal

[GSM™]

Правильно понимаю? При открытой второй форме перейти на первую нельзя, пока не закроешь вторую?
совершенно верно. но не получается что то не с этим -
Form2.Parent := Form1;
выделяет красным
не с этим-
Form2.Show
и не с этим-
Form2.ShowModal

[A2GIL]

Правильно понимаю? При открытой второй форме перейти на первую нельзя, пока не закроешь вторую?
GSM, верно все же будет:
Form2.ShowModal;
Просто если тебе выскочит сообщение, с тремя кнопками нажимай YES:)

[KIR@PRO]

Привет! Помогите пожайлуста дайте код на delphi
чтобы подключаться к Wi-Fi сети из своей программы...

и (или) подкинте какойнить хороший материал по этой теме и просто про wi-fi

с меня за код +++ за хороший больше... очень нада особенно чтобы мона было подключиться с защитой wpa wpa-2 and wep.... или подключаться средствами windows но чтоб программа передавала все параметры а винда тока подключалась с этими параметрами и давала ответ удачно или нет....

[Forcer]

и (или) подкинте какойнить хороший материал по этой теме и просто про wi-fi
http://forum.antichat.ru/thread48846-bluetooth.html

[GSM™]

http://slil.ru/25476735 тут исходники.

[zl0y]

Файл проэкта для начала создай FIle->New->Form Application или как там

[W!z@rD]

1. "комплит" а именно?
2. это тупо пустая форма, но без файла-проекта... dpr файла нет... никакой ценности там нет.
3. ты издеваешься?!??!! что за вопросы!?

[Loker]

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

[Jes]

http://forum.codeby.net/lofiversion/index.php/t19234.html

[Loker]

А нету вообще мануалов на эту тему, какихнить на тему работа с майлами, работа с аськой и т.д?

[Nightmarе]

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

[Попрошайка]

А нету вообще мануалов на эту тему, какихнить на тему работа с майлами, работа с аськой и т.д?

По аське всё здесь :
ICQ (http://forum.asechka.ru/showthread.php?t=97186&page=7)

С почтой - IMHO есть всё на форуме, поиск тебе поможет.

[GSM™]

такой вопрос. на форму поместил button1 и ComboBox1. в свойстве items компонента ComboBox записал допустим 1, 2, 3. как сделать так чтобы если пользователь выбрал в ComboBox'е свойство 1 и нажал button1 ему, допустим, окно развернулось на весь экран, если выбрал свойство 2 и нажал button1 то программа свернулась и если выбрал свойство 3 то программа закрылась?

[Joker-jar]

if Combobox1.ItemIndex = 0 then
...
if Combobox1.ItemIndex = 1 then
...
if Combobox1.ItemIndex = 2 then
...

[W!z@rD]

case Combobox1.ItemIndex of
1: ...;
2: ...;
3: ...;
end;

[GSM™]

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

и еще один. как изменить имя модуля по умолчанию Unit1?

[bons]

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

_http://www.delphisources.ru/pages/faq/base/create_splash.html

[GSM™]

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

[A2GIL]

а подскажите как сделать чтобы программа работала в фоне другой программы? ну например form1 запускалась с form2 сразу.
Если правильно понял тебя, то делается так: создаешь вторую форму затем например у Form1 в свойствах formstyle указываешь fsMDIForm, а у другой fsMDIChild. Или можно наоборот:)

[desTiny]

#1118, а если я правильно понял, то в конце юнита с Form1 пишешь initialization
Form2.Show
end.

[Freedom]

Ребят помогите плиз. Заеб...ся уже.

Есть Stringgrid и ComboBox
В Stringgrid загружены данные типа
1
2
3
4
2
3
2
3

В ComboBox забиты
1,2,3,4
Каким образом сделать чтобы при выборе в ComboBox например '2'
в Stringgrid оставались только строки с '2', потом если выбирать в ComboBox другие цифры то и Stringgrid адекватно реагировал на этот выбор. Заранее спасибо.

[presidentua]

Ребят помогите плиз. Заеб...ся уже.
Каким образом сделать чтобы при выборе в ComboBox например '2'
в Stringgrid оставались только строки с '2', потом если выбирать в ComboBox другие цифры то и Stringgrid адекватно реагировал на этот выбор. Заранее спасибо.
Самое простое, это создать два Stringgrid. Один невидимый где будет полностью все значений, а второй видимый.
Тоесть при нажатии на ComboBox, идет цыкл по всем значениям невидимого Stringgrid и если значения равно значению из ComboBox, то происходит копирования этого элемента в видимый Stringgrid.

Попробуй. Если не получится, то напишу маленькую процедурку.

[Смоки]

Привет всем! Подскажите программное решение, как узнать имена всех пользователей Windows, ну или хотя бы активного в данный момент ?

з.ы. на форуме искал и гуглил, ничего не нашёл.

[GSM™]

как добавить в хранилище и вставить из хранилища?
как добавить разобрался а вот как вставить на форму нет.

[Freedom]

to presidentua

спасибо за мыслю все сделал и получилось.

[Смоки]

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


type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
{$EXTERNALSYM NetUserEnum}
function NetUserEnum(servername: LPWSTR;

level,
filter: DWORD;
bufptr: Pointer;
prefmaxlen: DWORD;
entriesread,
totalentries,
resume_handle: LPDWORD): DWORD; stdcall;
external 'NetApi32.dll' Name 'NetUserEnum';

function NetApiBufferFree(Buffer: Pointer {LPVOID}): DWORD; stdcall;

external 'NetApi32.dll' Name 'NetApiBufferFree';

procedure GetLocalUserList(ulist: TStringList);

implementation

{$R *.dfm}

procedure GetLocalUserList(ulist: TStringList);
const

NERR_SUCCESS = 0;
FILTER_TEMP_DUPLICATE_ACCOUNT = $0001;
FILTER_NORMAL_ACCOUNT = $0002;
FILTER_PROXY_ACCOUNT = $0004;
FILTER_INTERDOMAIN_TRUST_ACCOUNT = $0008;
FILTER_WORKSTATION_TRUST_ACCOUNT = $0010;
FILTER_SERVER_TRUST_ACCOUNT = $0020;

type

TUSER_INFO_10 = record
usri10_name,
usri10_comment,
usri10_usr_comment,
usri10_full_name: PWideChar;
end;
PUSER_INFO_10 = ^TUSER_INFO_10;

var

dwERead, dwETotal, dwRes, res: DWORD;
inf: PUSER_INFO_10;
info: Pointer;
p: PChar;
i: Integer;
begin

if ulist = nil then
Exit;
ulist.Clear;

info := nil;
dwRes := 0;
res := NetUserEnum(nil,
10,
FILTER_NORMAL_ACCOUNT,
@info,
65536,
@dwERead,
@dwETotal,
@dwRes);
if (res <> NERR_SUCCESS) or (info = nil) then
Exit;
p := PChar(info);
for i := 0 to dwERead - 1 do
begin
inf := PUSER_INFO_10(p + i * SizeOf(TUSER_INFO_10));
ulist.Add(WideCharToString(PWideChar((inf^).usri10 _name)));
end;

NetApiBufferFree(info);
end;

procedure TForm1.Button1Click(Sender: TObject);
var list:TStringList;
begin
list:=Tstringlist.Create;
GetLocalUserList(list);
listbox1.Items:=list;

end;

end.

[GSM™]

подскажите как сделать чтобы при выборе файла в ListBox1 загружалось имя и путь например D:\12345\123\12\1.exe

[Jes]

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

if OpenDialog1.Execute
then
ListBox1.items.add(OpenDialog1.Filename)

[GSM™]

Могу ошибаться но что-то вроде этого...

if OpenDialog1.Execute
then
ListBox1.items.add(OpenDialog1.Filename)
спасибо не ошибся. а как теперь очищать можно окно ListBox1?

[GSM™]

и ты не ошибся спасибо за помощь но есть еще вопросик. как сделать горизонтальную прокрутку на ListBox'е?

[zl0y]

кого ''за*****'' тот может не отвечать. если умный такой то дай мне эту книгу где описаны все мои вопросы. я найти не смог.
без обид
да ну брось ты. какие обиды? корчишь тут из себя незнаю кого. помоему эту тему и создали чтобы новички как я могли вопрос задать.
Лень прочитать чтоль? http://www.google.com/search?q=%CA%ED%E8%E3%E8%20%EF%EE%20Delphi
По теме у ListBox'a есть параметр ScrollBars ставишь его в -> Both

[GSM™]

у ListBox'a нет параметра ScrollBars...

[Смоки]

ListBox1.ScrollWidth:=256;
256 - длинна линейки прокрутки в пиксклях. и гуглом пользуйся хоть иногда, нельзя ж про каждое свойство и процедуру компонента спрашивать.

[krypt3r]

SendMessage(ListBox1.Handle,LB_SETHORIZONTALEXTENT ,256,0);

ну или через ListBox1.Perform, что то же самое

[xaker-boss]

Люди как можно узнать сколько людей на сайт?
Ну к примеру возьмём булку, как сделать так чтобы программа заходила на сайт смотрела сколько людей щас присуствует и отображала мне число в edit1 ???
Плиз народ ну попробуйте ктонебуть, если можно исходник
Буду вам очень блогодарен

[LEE_ROY]

если на сайте стоит мод для отображения статистики типа - На сайте - 777 человек, или имена присутствующих онлайн, то просто скачиваеш гетом страницу и парсиш хтмл, а если стата отлючена то имхо никак.

[xaker-boss]

Не почему, в булке есть :(Сейчас посетителей: 255 (57 пользователей и 198 гостей))
еслибы я знал как это сделать, но я незнаю!
Кто может попробывать написать такую программку?

[dos999]

сайт в студию... ща выложу исходник.
хочу сделать так:
1. загрузить страничку в txt-файл (API)
2. найти слова 'сайчас на сайте: '
3. вытащить от туда значения

[krypt3r]

2. найти слова 'сайчас на сайте: '

Этого недостаточно. А если кодировка сайта не CP1251, а KOI8-R или UTF-8?

[Pir4tt]

сайт в студию... ща выложу исходник.
хочу сделать так:
1. загрузить страничку в txt-файл (API)
2. найти слова 'сайчас на сайте: '
3. вытащить от туда значения
грузи лучше не в файл, а в поток или строку, зачем лишние операции)) При гете указывай явно какая кодировка требуется; ну и на всякий может пригодится функция Utf8ToAnsi, так же оринетироваться при парсинге лучше по английским словам и тэгам ;)

[Freedom]

Ребят а как можно сменить пароль на email ? Вообще нигде ничего не могу найти по этому поводу.

Варианты типа: Парси страницу и находи поля ввода не катят.

Помогите плиз. С меня много много плюсов.

[Jes]

имхо , если у тебя нет прямого доступа к серверу , то как раз оптимален вариант:
"Парси страницу и находи поля ввода"

Хотя к конкретному сервису достаточно просто изучить сраницу редактирования и формировать соответствующий Post запрос...
простой например:
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
tL: TStringList;
s: String;
begin
tL := TStringList.Create;
tL.Add('password=пароль');
tL.Add('NewPassword=Новый пароль');
try
s := IdHTTP1.Post('адрес формы смены пароля',tl);
finally
tL.Free;
end;

[xaker-boss]

dos999, ну попробуй сделать на примере античата

[dos999]

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



function GetPart(ABegin, AEnd, Str: String): String;
var
b, c: Integer;
begin
if ABegin <> '' then
b := pos(ABegin, Str) + length(ABegin)
else
b := 1;
if AEnd <> '' then
c := pos(AEnd, Str) - b
else
c := length(Str) - b + 1;
Result := copy(Str, b , c);
end;

function ButtonClick(Sender: TObject): integer;
var
AStrings: TStringList;

function FindText: String;
var
i: Integer;
s: String;
begin
for i := 0 to AStrings.Count - 1 do
if pos('Сейчас на форуме </a>: ', AStrings[i]) > 0 then
begin
s := AStrings[i];
Result := GetPart('Сейчас на форуме </a>: ', ' (', s);
end;
end;

begin
AStrings := TStringList.Create;
Result := 0;
try
URLDownloadToFile(nil, 'http://forum.antichat.ru/', 'temp_file.txt', 0, nil);
AStrings.LoadFromFile('temp_file.txt');
Result := StrToInt(FindText);
DeleteFile('temp_file.txt');
finally
AStrings.Free;
end;
end;


что то вроде этого

PS. второй пост на форуме, строго не судите ;)

[Xszz]

Доброго времени суток .
Интересует следующее :
Многопоточность в Delphi в частности ICS .(если можно, пример использования)
И как узнать свой айпи . (т.е. какой айпи привязан к активному интерфейсу ?)
Спасибо

[Смоки]

2Xszz про определение ip-адресов интерфейсов: _http://www.delphimaster.ru/cgi-bin/forum.pl?id=1199825920&n=4

[Смоки]

вопрос по сокетам(winsock 1, 2) . Передачу данных никогда делать не пробовал. пользовался компонентами. решил попробовать и нифига не получаеться. конект есть, а данные или не передаются или не принимаются.
код сервера:
const
port = 256;
fname = 'c:\BUF.txt';
var
WSAData:TWSAData;
sock:TSocket;
SAddr:TSockAddr;
size_sa:integer;
buf:array[1..255] of char;
f:text;

begin
assign(f,fname);
rewrite(f);
if WSAStartup($202,WSAData)<>0 then
begin
writeln('startup error...');
exit;
end;
SAddr.sin_family:=AF_INET;
SAddr.sin_port:=htons(port);
sock:=socket(AF_INET,SOCK_STREAM,IPPROTO_IP);
if sock = INVALID_SOCKET then
begin
writeln('socket error...');
exit;
end;
if bind(sock,@SAddr,sizeof(SAddr))<>0 then
begin
writeln('bind error...');
exit;
end;
size_sa:=sizeof(SAddr);
listen(sock,1);
accept(sock,@SAddr,@size_sa);
recv(sock,buf,sizeof(buf),0);
append(f);
writeln(f,buf);
closesocket(sock);
close(f);
WSACleanup;
writeln('press any key to exit...');
end.

Код клиента:
port = 256;
ip = '192.168.10.33';
var
WSAData:TWSAData;
sock:TSocket;
SAddr:TSockAddr;
i,size_sa:integer;
buf:array[1..255] of char;

begin
if WSAStartup($202,WSAData)<>0 then
begin
writeln('startup error...');
exit;
end;
SAddr.sin_family:=AF_INET;
SAddr.sin_addr.S_addr:=inet_addr(pchar(ip));
SAddr.sin_port:=htons(port);
sock:=socket(AF_INET,SOCK_STREAM,IPPROTO_IP);
if sock = INVALID_SOCKET then
begin
writeln('socket error...');
exit;
end;
size_sa:=sizeof(SAddr);
if connect(sock,@SAddr,size_sa)<>0 then
begin
writeln('error connect...');
exit;
end;
for i:=1 to 26 do
buf[i]:=char((ord('a')-1)+i);
send(sock,buf,sizeof(buf),0);
writeln(buf);
closesocket(sock);
WSACleanup;
writeln('press any key for exit...');
end.

[Xszz]

как разбить строку вида 192.168.0.1 на 192 168 0 1 .
И как отсекать только последнюю часть ? т.е. (1) ? Чтоб в результате получать
192.168.0.
Спасибо .

[vipadmin]

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

[A2GIL]

как разбить строку вида 192.168.0.1 на 192 168 0 1 .
И как отсекать только последнюю часть ? т.е. (1) ? Чтоб в результате получать
192.168.0.
Спасибо .
Если конечно ты подразумевал работу со строками, то вот:
//удаляет все точки из строчки (рифма=))
function DelPoints(st:string):string;
var
i:integer;
begin
for i:=1 to length(st) do
if st[i]='.' then
st[i]:=' ';
result:=st;
end;
//удаление последнего числа после точки
function DelEnd(st:string):string;
var
i:integer;
begin
for i:=length(st) downto 1 do
if st[i]='.' then begin
result:=copy(st,1,i);//В данном случае точка в конце остается как ты и просил,
// ну а так result:=copy(st,1,i-1);её не будет
break;
end;
end;
//пример использования
procedure TForm1.Button1Click(Sender: TObject);
var
s:string;
begin
s:=Edit1.Text;
Edit2.Text:=DelPoints(s);
Edit3.Text:=DelEnd(s);
end;

[A2GIL]

Как проверить склеен ли файл джойнером ?
Ты что хочешь программу написать, которая бы это определяла? Если да то тебе нужно научиться работать с заголовками PE файлов, поскольку по EP(entry point) можно определить откуда начинается запуск файла. Дак вот если файл-результат работы склейщика, то запускается сначала движок джойнера (стаб). Поэтому если хошь сделать своего рода детектор, то нужно вести базу сигнатур (т.е известные стабы). Конечно нужно учитывать, что файл может быть еще и закриптованным!
А если просто хочешь визуально определить, то самый простой способ: берешь любой редоктор exe файлов, загружаешь и смотришь секции. Если новичок в этом можешь начать сResourceHacker...

[Myst]

как разбить строку вида 192.168.0.1 на 192 168 0 1
Насколько я понял ты хочешь из строки 192.168.0.1 получить 4 числа.
procedure getip(ip:string; var a,b,c,d:byte);
// ip - ip адрес в строковом формате, a,b,c,d - искомые числа

var
i:byte;
x:array[0..3]of byte;

begin
for i:=0 to 3 do begin
x[i]:=0;
while (ip<>'') and (ip[1]<>'.') do
begin
x[i]:=x[i]*10+strtoint(ip[1]);
delete(ip,1,1);
end;
if (ip<>'') and (ip[1]='.') then
delete(ip,1,1);
end;
a:=x[0];
b:=x[1];
c:=x[2];
d:=x[3];
end;

[Xszz]

Можно ли выгрузить Антивирус Касперского ?
пробовал следующие методы

winexec('cmd.exe /C taskkill /F /IM avp.exe /T',sw_hide);


Так же пытался

function KillTask(ExeFileName: string): Integer;
const
PROCESS_TERMINATE = $0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
Result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

while Integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeF ile)) =
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
Result := Integer(TerminateProcess(
OpenProcess(PROCESS_TERMINATE,
BOOL(0),
FProcessEntry32.th32ProcessID),
0));
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;


Не помогает ...
Спасибо .

[z01b]

Можно ли выгрузить Антивирус Касперского ?
пробовал следующие методы ...
Так его не убить. Юзай поиск по форуму, уже про это писали.

[Pernat1y]

а через net stop остановить службу?

[z01b]

а через net stop остановить службу?
Ня, никак!

[W!z@rD]

попробуй послать окну Каспера сообщения типа Wm_close или т.п.

[LEE_ROY]

антивирус ксперского использует дров для защиты процесса, нихера вы его так невыгрузите...

[Killerkod]

Его можно ведь просто вырубить без выгрузки, просто поставив на ПК например дату 01,01,1990 и каспер 7 вырубается

[Myst]

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

[KSoniX]

ну можна еше с помошью Winpooch вырубит каспер

[Pernat1y]

http://www.rootkit.com/newsread.php?newsid=778

[Freedom]

подскажите плиз. как отобразить на форме картинку с какого нибудь сайта ?
как её загрузить в TImage

[dos999]

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

http://forum.antichat.ru/antichat/pic/logo.gif

[dos999]

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

[FoFilder]

Проблема банальна, но ответа никак и нигде не могу найти.
Суть.
Как проверить существует ли директория на Ftp сервере?
Использую Delphi 7 и Indy10.

Пытался реализовать через DirectoryExists, но он всегда возвращает False.
Мне надо
проверка есть ли директория тогда IdFtp1.ChangeDir('/Logs_'+ip); а если нет то
IdFTP1.makeDir('Logs_'+ip);
IdFTP1.ChangeDir('/Logs_'+ip);

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

[Hellsp@wn]

дык создавай папку и всё :) если она есть, ничего не произойдёт, если нету, то появиться.

[FoFilder]

дык создавай папку и всё :) если она есть, ничего не произойдёт, если нету, то появиться.
Если она ЕСТЬ, то вылезает ошибка.Типо не могу создать директорию т.к. она есть.

[presidentua]

Если она ЕСТЬ, то вылезает ошибка.Типо не могу создать директорию т.к. она есть.
Используй "try"

[W!z@rD]

Проблема банальна, но ответа никак и нигде не могу найти.
Суть.
Как проверить существует ли директория на Ftp сервере?
Использую Delphi 7 и Indy10.

Пытался реализовать через DirectoryExists, но он всегда возвращает False.
Мне надо
проверка есть ли директория тогда IdFtp1.ChangeDir('/Logs_'+ip); а если нет то
IdFTP1.makeDir('Logs_'+ip);
IdFTP1.ChangeDir('/Logs_'+ip);

Но не знаю как проверить есть данная директория на Ftp.
Буду очень благодарен кто подскажет или скажет в каком направлении копать.
как вариант, воспользоваться блоком
try
...
except
...
end;

[Joker-jar]

О том, как перетаскивать файлы на форму написано достаточно, а вот о том, как перетаскивать из проги ничего путного найти не могу. В общем, нужно реализовать перетаскивание (drag-and-drop) из приложения в папку / рабочий стол. Total Commander как один из примеров

[Freedom]

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

http://forum.antichat.ru/antichat/pic/logo.gif
покажи плиз нга примерре я не догоню чегото

[Hellsp@wn]

обработай ошибку, я просто для фтп компоненты не юзаю, поэтому хз :)
там есть, что-то типо выполнения своих комманд? тогда выполни:
FtpQuote(pointer('MKD MYDIR"),pointer(buf),255);

[dos999]

покажи плиз нга примерре я не догоню чегото

всё это сделать в коде у меня не получилось, наверное нехватает каких то библиотек, а в ручную всё нормально... вобщем так:
1. помещаешь на форму Image1 (TImage)
2. в свойстве Picture нажимаешь на точки
3. в открывшимся окне нажимаешь load
4. в диалоговом окне в поле вставляешь адрес картирки
http://forum.antichat.ru/antichat/pic/logo.gif
5. потом везде нажимаешь ОК

Примечание: нужно чтобы в IE были правильные насройки подключения к интернету, т.к. Delphi по молчанию берёт настройки именно от туда

[Freedom]

2 dos999. блин. надо как нибудь в коде потому что картинка постоянно меняется. то есть название у нее постоянно разное.

[dos999]

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

[Freedom]

ты имеешь в виду разное название файла? или просто разное содержание картинки?
Разные картинки. Например 1.jpg, 2.jpg и т.д

[Pir4tt]

Freedom скозалбы что пишешь регер))
Берёшь страничку, парсишь её, находишь линку на картинку, потом вытворяешь с ней примерно такой код:http:=TIdHTTP.Create(nil);
msimg := TMemoryStream.Create;
try
http.Get('http://sie.net/kartinko.jpg', msimg);
msimg.Position := 0;
finally
http.Free;
end;
end; получается у тебя картико в потоке, потом добавляешь:NewGraphic := TJpegImage.Create;
try
NewGraphic.LoadFromStream(msimg);
Image1.Picture.Graphic := NewGraphic;
finally
NewGraphic.Free;
end; и получается картинко на формочке в имаге, в юзес не забудь jpeg добавить ;)

[x-treem]

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

[Freedom]

Freedom скозалбы что пишешь регер))
Берёшь страничку, парсишь её, находишь линку на картинку, потом вытворяешь с ней примерно такой код: получается у тебя картико в потоке, потом добавляешь: и получается картинко на формочке в имаге, в юзес не забудь jpeg добавить ;)

Спасибо. Помогло.

Не регер :) а, программку для смены пароля на mail.ru а там картинка эта. :)

[desTiny]

Добрый день. Пишу на делфях на чистом WinApi. Возникла проблема. Нужно в теле самой программы нести графический файл, после чего выгружать его в отдельный файл на диске. Подскажите, как это реализовать.
Что значит "нести"?

[z01b]

Что значит "нести"?
Он наверное имел в виду в ресурсах его записать и потом из ресурсах на диск.

[desTiny]

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

[bons]

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



Это извлечет файл из ресурсов, если он конечно там будет


function fWrite(hFile: THandle; Buffer:pointer; nNumberOfBytesToWrite: DWORD; var lpNumberOfBytesWritten: DWORD; lpOverlapped: POverlapped): BOOL; stdcall; external 'kernel32.dll' name 'WriteFile';

function ExtractFile(ResType,ResName,FileName:pChar):boolea n;
var rc,f,bw,pRes:cardinal;
begin
result:=false;
rc:=FindResource(0,ResType,ResName);
if rc=0 then exit;
pRes:=LoadResource(0,rc);
if pRes=0 then exit;
f:=CreateFile(FileName,GENERIC_WRITE,FILE_SHARE_WR ITE,nil,CREATE_NEW,
FILE_ATTRIBUTE_NORMAL, 0);
if f=INVALID_HANDLE_VALUE then exit;
fWrite(f,pointer(pRes),SizeofResource(0,rc),bw,nil );
CloseHandle(f);
FreeResource(pres);
result:=true;
end;

[W!z@rD]

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

1
в блокноте пишешь:
pinch_exe RCDATA Pinch.exe
сохраняешь файл под именем (к примеру) pinch.rc

2
в консоли
brcc32 -32 c:\SuperPinch\pinch.rc
на выходе получишь pinch.res

3
подключаешь ресурс
{$R pinch.res}

4
procedure ExtractRes;
var Res:TResourceStream;
begin
Res:=TResourceStream.Create(HInstance,'pinch_exe', RT_RCDATA);
Res.SaveToFile('Pinch.exe');
Res.Free;
end;

[neon_fx]

Кто работает Delphi+mySql
Скиньте пару исходников
плиз

[Joker-jar]

http://www.mysql.ru/cgi-bin/download/DelphiMySQL.zip только там какая то структура неправильно описана, надо сверить с вариантом на C (тоже есть на сайте). Точно не помню какая, поищи

[ToniKapuchon]

Возник ламерский вопрос:
Можн ли в delphi написать нечто подобное : a:array[21] of TLabel;

[bons]

нет, но можно
var a:array[0..21] of procedure;

[presidentua]

Кто работает Delphi+mySql
Скиньте пару исходников
плиз
Если будет мало того что дал Joker-jar, то напишы скинут тебе еще один исходничек со всеми библиотеками и прочей ерундой, когда то писал курсак на заказ.

[ForNeVeR]

ToniKapuchon, ей-богу, делал как-то массивы компонентов! Так что ответ - можно. Более точно скажу, если найду исходники ;)

[rasl]

Программа аппроксимации методом наименьших квадратов на основе степенного полинома с визуализацией графиков функций (Windows API)

хелп

[presidentua]

ШО? :)
Это задача на Докторскую роботу :)
Слова знакомые, но вместе составляют незнакомое.

А для графиков в делфи есть отличые компоненты. Там все в визуальном режиме, почти как в Екселе, только проще. А потом указываеш масив точек и все красиво получается.
ТChart

[presidentua]

По просьбе neon_fx. Вилаживаю архив с примером роботы из Делфи с МуСкулом. В архиве исзодники, нужные библиотеки и также есть папка ДБ в которой база даных МуСкула, которую нада забросить к остальным базам. Тестировалось все на Денвере в качестве Мускула и компилировалось в Делфи 7.

http://dump.ru/files/o/o0962827523/

[Ta2i4]

!!!Вопрос по Delphi 2007!!!

Предисловие:
Имеется простейший текст-редактор, загружающий текст в компонент TJvEditor (похож на Memo, из JediVCL) стандартным методом LoadFromFile.
Проблема в том, что таким методом нельзя прочесть весь файл форматов юникод или бинарный. Простые (windows,ansi) файлы он читает нормально.
Компонент JvWideEditor, напротив читает только юникод, не читая обычные файлы и бинарные.

Я нашел такой способ:
var
f: file;
c: Char;
begin
if OpenDialog1.Execute then begin
JvEditor1.Clear;
AssignFile(f,OpenDialog2.FileName);
Reset(f, 1);
while not Eof(f) do begin
BlockRead(f, c, SizeOf(c));
JvEditor1.InsertText(c);
Application.ProcessMessages;
end;
CloseFile(f);
end;
end;
НО!!! Такой алгоритм читает файлы по одному символу слишком медленно. Тем не менее, юникод-файл грузится.

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

[zl0y]

!!!Вопрос по Delphi 2007!!!

Предисловие:
Имеется простейший текст-редактор, загружающий текст в компонент TJvEditor (похож на Memo, из JediVCL) стандартным методом LoadFromFile.
Проблема в том, что таким методом нельзя прочесть весь файл форматов юникод или бинарный. Простые (windows,ansi) файлы он читает нормально.
Компонент JvWideEditor, напротив читает только юникод, не читая обычные файлы и бинарные.

Я нашел такой способ:

НО!!! Такой алгоритм читает файлы по одному символу слишком медленно. Тем не менее, юникод-файл грузится.

Задача:
Максимально увеличить производительность и скорость чтения файла.
Напиши мне в icq,помогу.

[W!z@rD]

самое простой и оптимальный вариант (имхо) это использовать потоки...

500-е сообщение ^_^

[Ta2i4]

Еще вопрос:
Как на Delphi написать такое распознавание кодировки, как это делает текст-редактор AkelPad (akelpad.sf.net)? Можно на WinAPI, но желательно на VCL.
Буду вообще благодарен, если пришлете такой pas-модуль, который позволяет работать с файлами, загружая в Memo файлы любой кодировки польностью, а также сохранять файлы в выбранной кодировке.

[Patrik]

Как на Delphi программно изменить FileVersion в ресурсах какого-нибудь .exe или .bpl файла?

[kair]

плиззз, помогите, такая проблема.
нужен исходник для delphi кторый рисует анимированную форму как в ворде, (скрепка)

[W!z@rD]

анимированную форму?
мб проще будет расположить gif и сделать форму прозрачной?

[Undernative]

Народ любимый :) Срочняк надо задачу решить...Дельфю вообще не знаю....


ОЧень срочно, в течении минут 20

Дан вектор. Заменить нулевые элементы вектора числом Р



Там по теме массивов..плиз ребяяяяят

[W!z@rD]

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

[Joker-jar]

Как вытащить из екзешника его описание?

[Jes]

его описание?описание?
PE хидер ?

[De-visible]

Вот код на делфи:
ICQ:array [1..15] of TICQClient;
For i:=0 to Memo1.Lines.Count-1 Do
Begin
ICQ[i]:=TICQClient.Create(nil);
num:=Memo1.Lines[i];
pass:=Memo2.Lines[i];
ICQ[i].UIN:=StrToInt(num);
ICQ[i].Password:=pass;
ICQ[i].Login();
end;

как мне после подключения, узнать какие uin'ы подключились а какие нет!
И допустим пользоваиель отправил сообщение на какойто из этих номеров как узнаь на какой?

[Pir4tt]

насчёт онлайн проверки - поставь обработчик на OnLogin, либо наоборот на OnConnectionFailed.. На счёт как номер узнать, добавь попробуй в цикл
icq[i].onMessageRecv:=newMessRecv; которая будет представлять собой немного изменённый обработчик, который кросе номера отправителя и мессаги будут принимать и номер на который пришло

[De-visible]

насчёт онлайн проверки - поставь обработчик на OnLogin, либо наоборот на OnConnectionFailed.. На счёт как номер узнать, добавь попробуй в цикл

не работает почему то!
я создаю массив компонентов....

[Joker-jar]

описание?
PE хидер ?
Вот например:
http://smages.com/t/a1/60/a1609b18749bf94af7c21a8f9c75f5aa.jpg (http://smages.com/a1/60/a1609b18749bf94af7c21a8f9c75f5aa.jpg.htm)

[Joker-jar]

Вот ответ на мой ворос :)
function GetFileDescription(FileName: string): string;
var
szName: array[0..255] of Char;
P: Pointer;
Value: Pointer;
Len: UINT;
GetTranslationString:string;
FFileName: PChar;
FValid:boolean;
FSize: DWORD;
FHandle: DWORD;
FBuffer: PChar;
begin
try
FFileName := StrPCopy(StrAlloc(Length(FileName) + 1), FileName);
FValid := False;
FSize := GetFileVersionInfoSize(FFileName, FHandle);
if FSize > 0 then
try
GetMem(FBuffer, FSize);
FValid := GetFileVersionInfo(FFileName, FHandle, FSize, FBuffer);
except
FValid := False;
raise;
end;
Result := '';
if FValid then
VerQueryValue(FBuffer, '\VarFileInfo\Translation', p, Len)
else p := nil;
if P <> nil then
GetTranslationString := IntToHex(MakeLong(HiWord(Longint(P^)), LoWord(Longint(P^))), 8);
if FValid then
begin
StrPCopy(szName, '\StringFileInfo\' + GetTranslationString + '\FileDescription');
if VerQueryValue(FBuffer, szName, Value, Len) then
Result := StrPas(PChar(Value));
end;
finally
try
if FBuffer <> nil then FreeMem(FBuffer, FSize);
except
end;
try
StrDispose(FFileName);
except
end;
end;
end;

[GSM™]

Подскажите что за ерунда. В программе несколько десятков кнопок. Компилирую 1 раз - работает пару кнопок. С 10 попытки еще одна начинает работать. А как сделать что бы заработала программа полностью
Думал делфи гонит, но переустонавливал несколько раз в том числе и на чистую винду.

[krypt3r]

В программе несколько десятков кнопок.
Нафига тебе столько? о_О

[GSM™]

Если быть точнее то 33 кнопки.
Нафига тебе столько? о_О
ну надо.

[desTiny]

Если быть точнее то 33 кнопки.

ну надо.
Алфавит?

А вообще поудаляй чуток - посмтри, что надо, чтобы всё работало... эксперементируй :)
Ps Кинь исходник..

[Joker-jar]

Попробуй для всех кнопок указать один метод OnClick, в котором анализируй Sender

[Manoff]

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

[Ergoproxy]

Дык тут надо компонент Icq и всё там дальше дело техники)

http://forum.root-access.ru/index.php?showtopic=478
Вот тут всё описано чё да как) зы это не реклама)

[De-visible]

Вот исходник моего старого(простенького) бота ("Команды вводи сам:)")

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ICQClient,ICQWorks, XPMan, ExtCtrls, Menus, ComCtrls,
jpeg;

type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
GroupBox2: TGroupBox;
Edit5: TEdit;
Label6: TLabel;
ICQ: TICQClient;
XPManifest1: TXPManifest;
Timer1: TTimer;
Label9: TLabel;
Label10: TLabel;
Menu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
Button6: TButton;
GroupBox3: TGroupBox;
Memo1: TMemo;
CheckBox1: TCheckBox;
Image1: TImage;
GroupBox4: TGroupBox;
Pop1: TPopupMenu;
N9: TMenuItem;
RANDOM1: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ICQLogin(Sender: TObject);
procedure ICQConnectionFailed(Sender: TObject);
procedure ICQMessageRecv(Sender: TObject; Msg, UIN: String);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
uses unit2;
type
ICQmsg=array [1..3] of string;
ICQFormat=object
uin:integer;
Msg:string;
end;
var
strokin:string;
ICQ_bufer:array [1..20] of ICQFormat;
MSGT:string;
LogFile:TextFile;
AnekdotFile:Textfile;
Comands:TextFile;
UinBaz:TextFile;
Drevo:Tlist;
{$R *.dfm}
function find_icq():byte;
var
ch,chcol:byte;
begin
chcol:=0;
for ch:=1 to 10 do
if ICQ_bufer[ch].uin<>0 then chcol:=chcol+1;
find_icq:=chcol;
end ;
procedure TRACE (txts:string);
begin
strokin:='>>'+' {'+txts+'}'+'!';
form1.Memo1.Lines.Add(strokin);
end;
procedure smsik (txts:string);
begin
form1.Memo1.Lines.Add(' <> '+txts);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
i:byte;
begin
ICQ.ConvertToPlaintext:=true;
trace('Ожидаем...');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ICQ.UIN:=StrToInt(edit1.Text);
ICQ.Password:=edit2.Text;
ICQ.ICQServer:='login.icq.com';
ICQ.ICQPort:=5190;
icq.Status:=8;
ICQ.Login();
trace('Пробуем соединится...');
icq.Status:=8;
end;

procedure TForm1.ICQLogin(Sender: TObject);
begin
Form1.Enabled:=true;
trace('Подключились...');
Application.MessageBox('Мы удачно подключились!','Внимание! ICQ_BOT говорит:',48);

end;

procedure TForm1.ICQConnectionFailed(Sender: TObject);
begin
Form1.Enabled:=true;
Button1.Enabled:=true;
trace('Соеденение разорвано...');
Application.MessageBox('Мы не смогли соединится!','Внимание! ICQ_BOT говорит:',48);
end;

procedure TForm1.ICQMessageRecv(Sender: TObject; Msg, UIN: String);
var
i,j:byte;
begin
Memo1.Lines.Add('|| '+'['+UIN+']'+' ='+' '+MSG);
ICQ.RequestInfo(StrToInt(UIN));
ICQ.SendAuthResponse(StrToInt(UIN),true,'yes');
for i:=1 to 20 do
if ICQ_bufer[i].uin=0 then
begin
ICQ_bufer[i].uin:=strtoint(uin);
ICQ_bufer[i].msg:='Privet';
break;
end;
timer1.Enabled:=true;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
trace('Выходим...');
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
bufer:array [1..20] of ICQFormat;
i,j:byte;
begin
timer1.Interval:=StrToInt(edit5.Text);
for i:=1 to 20 do
for j:=i+1 to 20 do
begin
if ICQ_bufer[i].uin=0 then
begin
bufer[i]:=ICQ_bufer[i];
ICQ_bufer[i]:=ICQ_bufer[j];
ICQ_bufer[j]:=bufer[i];
end;
end;
if find_icq=0 then
begin
timer1.Enabled:=false;
exit;
end;
label9.Caption:=inttostr(find_icq);
icq.SendMessage(ICQ_bufer[1].uin,ICQ_Bufer[1].msg);
ICQ_bufer[1].uin:=0;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
icq.Status:=1;
button6.Caption:='Отошел';
end;

procedure TForm1.N2Click(Sender: TObject);
begin
icq.Status:=2;
button6.Caption:='Не беспокоить';
end;

procedure TForm1.N3Click(Sender: TObject);
begin
icq.Status:=4;
button6.Caption:='Недоступен';
end;

procedure TForm1.N4Click(Sender: TObject);
begin
icq.Status:=8;
button6.Caption:='В сети';{ICQ.SendMessage(StrToInt(edit3.Text),ed it4.Text);
Trace('Бот отправил сообщение'+' '+'['+edit3.Text+']');}
end;

procedure TForm1.N5Click(Sender: TObject);
begin
icq.Status:=16;
button6.Caption:='Занят';
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
menu1.Popup(mouse.CursorPos.X,mouse.CursorPos.y);
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if
form1.ClientHeight=462 then
form1.ClientHeight:=346 else
form1.ClientHeight:=462;
end;

end.


Думаю разберешься - ЭТО так сказать "скелет" простенького бота:)

[Twiddle]

Господа, подскажите код что бы из xxx.txt удалялись дубли строчек и сохранялось в xxx1.txt
Delphi plz

[ToniKapuchon]

На компоненте TImage рисую кружочки.... При нажатии по button хочу удалять нарисованное (свои кружки), что за свойство? Типа что то Image1.*****?

[De-visible]

Господа, подскажите код что бы из xxx.txt удалялись дубли строчек и сохранялось в xxx1.txt
Delphi plz


Из DelphiWorld:)
procedure TForm1.Button1Click(Sender: TObject);
var
sl: TStringList;
begin
sl := TStringList.Create;
try
with sl do
begin
// Duplicates does nothing
// if the list is not sorted.
Sorted := True;
// Ignore attempts to add
// duplicate strings to the list.
Duplicates := dupIgnore;
Add(Edit1.Text);
end;
Listbox1.Items.Assign(sl);
finally
sl.Free;
end;
end;

[De-visible]

На компоненте TImage рисую кружочки.... При нажатии по button хочу удалять нарисованное (свои кружки), что за свойство? Типа что то Image1.*****?



Image1.Picture:=nil;

[Twiddle]

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

[desTiny]

хм, по моему мне не подходит этот код. Мне как раз надо что бы из мусорного файла создавался нормальнеый ге каждая строка уникальная. т.е. просто что бы удалил повторы.... можно даже в старом файле.
Предлагаю с такими вопросами посылать на sources.ru... Или заваливать умными словами типа юзай либо подправленный КМП, либо хеши, сравнивай строки таким образом, храни их однонаправленным списком, дальше выводи список с 1-го элемента, и пока equal((s.next)^.string,s.string) делать s = s.next иначе writeln(s.string).

PS Надоели вопросы, когда люди думать не хотят. Всё, ясно?! Вперёд писать. У тебя 10 минут.

[Twiddle]

Не смог найти... Как запретить Twebbrowser выполнять яваскрипты?

[ToniKapuchon]

Image1.Picture:=nil;

При етом моя картинка удаляется...!!! В чём загвоздка?

[De-visible]

А тебе что именно надо???

[desTiny]

При етом моя картинка удаляется...!!! В чём загвоздка?
Воистину невероятно! А ты думал, там что появится?

[dos999]

Воистину невероятно! А ты думал, там что появится?
наверное что там появиться cлово "нил")))

[ToniKapuchon]

Очень ржачно, я планировал, что моя картинка обновиться или перегрузиться!! refresh какой что ли...

[desTiny]

Очень ржачно, я планировал, что моя картинка обновиться или перегрузиться!! refresh какой что ли...
Image1.Picture:=nil;
Image1.Picture.LoadFromFile('моя картинка');

[Manoff]

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

[desTiny]

Manoff,
Delphi -> Help -> Windows SDK

[z01b]

А по ВинАпи толковый справочник(желательно с примерами) у кого-нибудь есть , а то
нашёл пару штук , половины функций в них нет :( .
http://www.winasm.net/index.php?ind=downloads&op=entry_view&iden=23

[De-visible]

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

_http://samouchka.net/engine/download.php?id=367
Очень не плохой справочник...

[desTiny]

А вот и у меня вопрос возник :) Это конечно не критично, но всё же:

Как получить указатель на функцию из стандартных модулей, например, на функцию sin?

Я делал так:
type
num = Extended;
TFunc = function(x: num):num;
var
p: TFunc;

......
function sinus(x: num):num;
begin
result := sin(x);
end;
......
p := @sinus;


А хочется чего-нибудь типа
p := @System.sin;
,но так оно не работает.

[De-visible]

Я вопроса не понял:)

[desTiny]

Коротко: хочу получить указатель на функцию sin :)

[De-visible]

{ Это простой пример, определяющий массив указателей на функции }

interface

type

{ определяем Procs как функцию }
Procs = function(var ProcNum: LongInt): LongInt;

var

{ объявляем массив указателей на функции }
ProcTable: array[1..5] of Procs;

{ определения интерфейсов функций }
function Proc1(var MyVal: LongInt): LongInt; far;
function Proc2(var MyVal: LongInt): LongInt; far;
function Proc3(var MyVal: LongInt): LongInt; far;
function Proc4(var MyVal: LongInt): LongInt; far;
function Proc5(var MyVal: LongInt): LongInt; far;
Ну или посмотри здесь :)
_http://www.soft32.ru/delphi.shtml?topic=syntax&title=function_pointer

[desTiny]

{ Это простой пример, определяющий массив указателей на функции }

interface

type

{ определяем Procs как функцию }
Procs = function(var ProcNum: LongInt): LongInt;

var

{ объявляем массив указателей на функции }
ProcTable: array[1..5] of Procs;

{ определения интерфейсов функций }
function Proc1(var MyVal: LongInt): LongInt; far;
function Proc2(var MyVal: LongInt): LongInt; far;
function Proc3(var MyVal: LongInt): LongInt; far;
function Proc4(var MyVal: LongInt): LongInt; far;
function Proc5(var MyVal: LongInt): LongInt; far;
Ну или посмотри здесь :)
_http://www.soft32.ru/delphi.shtml?topic=syntax&title=function_pointer
В том-то и дело, что мне нужно обратиться не к моей собственной функции, а к стандартной типа sin, cos, abs и т.п. Так, как ты пишешь, я и сделал (см. приведённый мной пример), но мне интересно, как сделать это непосредственно...

[De-visible]

А вот и у меня вопрос возник :) Это конечно не критично, но всё же:

Как получить указатель на функцию из стандартных модулей, например, на функцию sin?

Я делал так:
type
num = Extended;
TFunc = function(x: num):num;
var
p: TFunc;

......
function sinus(x: num):num;
begin
result := sin(x);
end;
......
p := @sinus;


А хочется чего-нибудь типа
p := @System.sin;
,но так оно не работает.

Извини, но я больше не знаю как:(

А что так не устраивает???

[desTiny]

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

[KIR@PRO]

дайте пожалуйста код хеширования строки в NT и/или LM как в проге SAMinside иди Passwordpro...

[De-visible]

дайте пожалуйста код хеширования строки в NT и/или LM как в проге SAMinside иди Passwordpro...
Тебе важны сами алгоритмы или их реализации на DELPHI??

-------------------------

Вот посмотри еще:

_http://inf.nm.ru/lokalno.htm
_http://www.3dnews.ru/software/win-xp-encrypting/index2.htm
_http://www.openwall.com/john/
_http://www.connect.ru/article.asp?id=6641
_http://www.web-hack.ru/download/index.php?case=4
_http://book.itep.ru/6/des_641.htm
_http://www.kursovik.net/programming/290019.html

[Twiddle]

Подскажите плз как изменить что бы не было повторов в найденом? ВОт код:

procedure poisk;
var S, Q: TStrings;
I, J: Integer;
begin
S := TStringList.Create;
Q := TStringList.Create;
S.LoadFromFile('C:\bla-bla.txt');
I := 0;
J := 0;
while I<S.Count-1 do
begin
if Pos('string 1', S.Strings[I])<>0 then
begin
Q.Add(S.Strings[I]);
Inc(I);
Inc(J);
Q.Add(S.Strings[I]);
Q.Add('');
end;
Inc(I);
end;
if J>0 then
begin
Q.Insert(0, '');
Q.Insert(0, DateToStr(Now));
Q.Insert(0, 'Naydenno '+IntToStr(J)+' strok');
Q.SaveToFile('c:\result.txt');
end;

S.Free;
Q.Free;
end;

[De-visible]

Подскажите плз как изменить что бы не было повторов в найденом? ВОт код:

procedure poisk;
var S, Q: TStrings;
I, J: Integer;
begin
S := TStringList.Create;
Q := TStringList.Create;
S.LoadFromFile('C:\bla-bla.txt');
I := 0;
J := 0;
while I<S.Count-1 do
begin
if Pos('string 1', S.Strings[I])<>0 then
begin
Q.Add(S.Strings[I]);
Inc(I);
Inc(J);
Q.Add(S.Strings[I]);
Q.Add('');
end;
Inc(I);
end;
if J>0 then
begin
Q.Insert(0, '');
Q.Insert(0, DateToStr(Now));
Q.Insert(0, 'Naydenno '+IntToStr(J)+' strok');
Q.SaveToFile('c:\result.txt');
end;

S.Free;
Q.Free;
end;




while I<S.Count-1 do
Зачем так - он у тебя последнюю строку не проверит!
пиши так
while i<S.count или while i<=s.count-1
А что бы в result.txt не было повторов
сделай повторный поиск поэтому файлу:) :D
===============================
procedure poisk;
var SL,Ish: TStringList;
i:integer;
begin
ISH:=TstringList.Create;
ISH.LoadFromFile('d1.txt');
SL := TStringList.Create;
with SL do
try
Sorted := True;
For i:=0 to ISH.Count-1 Do Begin
SL.Add(ISH[i]);
end;
Duplicates := dupIgnore;
sl.SaveToFile('result.txt');
finally
Free;
end;
end;
-----------------------------
Удаляет все дубликаты и сохраняет в result.txt
А чего ты именно хочешь?()
Вывести сколько раз в файле встречается строка String 1?

[z01b]

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

[zl0y]

program name;

{$APPTYPE CONSOLE}

uses
SysUtils;
var TmpName : string;
Count,i : Integer;

begin
WriteLn('What is your name? and credit card number;)');
ReadLn(TmpName);
WriteLn('Enter number te repeat:');
ReadLn(Count);
if Count=0 then exit;
for i:=1 to Count do WriteLn(TmpName);
end.

[z01b]

program name;

{$APPTYPE CONSOLE}

uses
SysUtils;
var TmpName : string;
Count,i : Integer;

begin
WriteLn('What is your name? and credit card number;)');
ReadLn(TmpName);
WriteLn('Enter number te repeat:');
ReadLn(Count);
if Count=0 then exit;
for i:=1 to Count do WriteLn(TmpName);
end.

File not found <SYSUTILS.TPU>. Не пашет твоя программа.

[Twiddle]

De-visible
Спасибо, код procedure poisk;
var SL,Ish: TStringList;
i:integer;
begin
ISH:=TstringList.Create;
ISH.LoadFromFile('d1.txt');
SL := TStringList.Create;
with SL do
try
Sorted := True;
For i:=0 to ISH.Count-1 Do Begin
SL.Add(ISH[i]);
end;
Duplicates := dupIgnore;
sl.SaveToFile('result.txt');
finally
Free;
end;
end;
работает но есть одно но. Моя прога зачастую ищет и записывает в файл сочетания строк. Нпример:
Строка имени
Стрка адресса

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

[MSDEN]

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

[De-visible]

я в дельфи вообще не силен...
подскажите пожалуйста как сделать билдер(как пинчбилдер) если есть исходник программы?

Используй компилятор Delphi pascal compiler DCC32.EXE используемые модули:)

[MSDEN]

Используй компилятор Delphi pascal compiler DCC32.EXE используемые модули:)
имелось ввиду что это какраз меня не устраивает

[z01b]

Slesh выкладывал сырцы своего билда в паплик. Поиск рулит карочи ;)

[desTiny]

Slesh выкладывал сырцы своего билда в паплик. Поиск рулит карочи ;)
Билдер пинча?? Там же несколько байт(адрес мыла или гейта) заменить в откомпиленном файле - и хватит...

[z01b]

Билдер пинча?? Там же несколько байт(адрес мыла или гейта) заменить в откомпиленном файле - и хватит...
Дык, ну да, там у него откомпиленый файл, в ресурсах.

[desTiny]

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

[MSDEN]

ну хоть кто-нибудь сможет помочь?

[ForNeVeR]

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

[Manoff]

А русификатор Делфи есть у кого-нть ? Если есть - дайте ПлиЗ . Заранее спасибо.

[De-visible]

У меня есть:) Но заливать долго инет 56кб/сек

[Manoff]

Жаль , а где взял - не помнишь?