Форум: "Основная";
Текущий архив: 2003.11.20;
Скачать: [xml.tar.bz2];

Вниз

Чтоб не выводились надписи   Найти похожие ветки 

← →
RoLeX   (2003-11-09 19:13) [0]

Вот код:
program sendmail;
{$i+}
{$apptype console}

uses
CrtSock,SysUtils;

var
host:integer;
sin,sout:TextFile;

sHost :string;
sFrom :string;
sTo :string;
sCc :string;
sType :string;
sSubject:string;
sBody :string;
boundary:string;

s:string;
us:string;
p:integer;

procedure Help;
begin
writeln("SENDMAIL [Host:server] From:email To:email [Cc:email] Subject:"ab c" [msg] [$include filename.ext]");
writeln(" $include joinfile.ext");
writeln(" $boundary");
halt;
end;

procedure Wait(code:char);
begin
Readln(sin,s);
writeln(s);
if s[1]<>Code then halt;
end;

procedure Echo(s:string);
begin
writeln(s);
writeln(sout,s);
end;

function include(filename:string):string;
var
f:file;
s:string;
u:string;
i,x:integer;
ss:integer;
c1,c2:byte;

function uuchr(b:byte):char;
begin
if b=0 then result:=#96 else result:=chr(b+32);
end;

begin
assignfile(f,filename);
reset(f,1);
if ioresult<>0 then begin
result:="$include ""+filename+"" read error";
exit;
end;
result:=#13#10"begin 600 "+filename+#13#10;
setlength(s,76);
while not eof(f) do begin
blockread(f,s[1],45,i);
u:=uuchr(i); // UUCoded line lenght
ss:=2;
c2:=0;
for x:=1 to i do begin
c1:=ord(s[x]);
u:=u+uuchr(c2 or (c1 shr ss));
c2:=(c1 shl (6-ss)) and 63;
ss:=(ss+2) and 7;
if ss=0 then begin
ss:=2;
u:=u+uuchr(c2);
c2:=0;
end;
end;
if (ss>2) then begin
u:=u+uuchr(c2)+#96;
if ss=4 then u:=u+#96;
end;
result:=result+u+#13#10;
end;
result:=result+#96#13#10"end"#13#10;
end;

procedure ReadMail;
var
f:TextFile;

procedure doline;
begin
if (copy(s,1,9)="$include ") then begin
sBody:=sBody+#13#10+include(copy(s,10,length(s)));
end else
if (s="$boundary") then begin
sBody:=sBody+#13#10"--"+boundary;
end else begin
sBody:=sBody+#13#10+s;
end;
end;

begin
assignfile(f,ParamStr(1));
reset(f);
if ioresult<>0 then begin
writeln("file not found");
halt;
end;
while not eof(f) do begin
readln(f,s);
us:=uppercase(s);
if copy(us,1,5)="HOST:" then sHost :=copy(s,6,length(s)) else
if copy(us,1,5)="FROM:" then sFrom :=copy(s,6,length(s)) else
if copy(us,1,3)="TO:" then sTo :=copy(s,4,length(s)) else
if copy(us,1,3)="CC:" then sCc :=copy(s,4,length(s)) else
if copy(us,1,5)="TYPE:" then sType :=copy(s,6,length(s)) else
if copy(us,1,8)="SUBJECT:" then sSubject:=copy(s,9,length(s)) else break;
end;

sBody:="";
doline;
while not eof(f) do begin
writeln("--",s);
readln(f,s);
doline;
end;
p:=Paramcount+1;
end;

begin
FileMode:=0; // ReadOnly

sHost :="";
sFrom :="";
sTo :="tothpaul@free.fr";
sCc :="";
sSubject:="SendMail";
sBody :="(test)";

if (ParamCount=0)or(ParamStr(1)="/?") then Help;

boundary:="----=_NextPart_Of_This_Mail";
if ParamCount=1 then
ReadMail
else begin
p:=1;
while p<=ParamCount do begin // Form, To, Cc, Subject
s:=ParamStr(p); if s="/?" then Help;
us:=uppercase(s);
if copy(us,1,5)="HOST:" then sHost :=copy(s,6,length(s)) else
if copy(us,1,5)="FROM:" then sFrom :=copy(s,6,length(s)) else
if copy(us,1,3)="TO:" then sTo :=copy(s,4,length(s)) else
if copy(us,1,3)="CC:" then sCc :=copy(s,4,length(s)) else
if copy(us,1,8)="SUBJECT:" then sSubject:=copy(s,9,length(s)) else break;
inc(p);
end;

if p<=ParamCount then sBody:="";
while p<=ParamCount do begin // Body
s:=ParamStr(p);
if s="$include" then begin
inc(p);
sBody:=sBody+include(ParamStr(p));
end else
sBody:=sBody+ParamStr(p)+" ";
inc(p);
end;

end;

if sHost="" then exit;
if sFrom="" then exit;

write("call server...");
host:=CallServer(sHost,25);
if host=-1 then begin
writeln("not found");
exit;
end;
AssignCrtSock(host,sin,sout);
Wait("2");
Echo("HELO "+sHost);
Wait("2");
Echo("MAIL From:<"+sFrom+">");
Wait("2");
Echo("RCPT To:<"+sTo+">");
Wait("2");
if sCc<>"" then begin
Echo("RCPT To:<"+sCc+">");
Wait("2");
end;
Echo("DATA");
Wait("3");
Echo("From: "+sFrom);
Echo("To: "+sTo);
if sCc<>"" then Echo("Cc: "+sCc);
if sType<>"" then Echo("MIME-Version: 1.0"#13#10"Content-Type: "+sType+";"#13#10#9"boundary=""+boundary+""");
Echo("Subject: "+sSubject+#13#10);
// writeln(sBody);
WriteLn(sout,sBody);
if sType<>"" then Echo(#13#10"--"+boundary+"--"#13#10);
Echo(".");
Wait("2");

Echo("QUIT");
Wait("2");

Close(Input);
ReadLn;
end.

Как переделайте его, чтоб на экран не выводились надписи!!!
Очень вас прошу!

---

← →
Anatoly Podgoretsky   (2003-11-09 19:16) [1]

Убираем все WriteLn вывода на консоль.

---

← →
RoLeX   (2003-11-09 19:21) [2]

> Anatoly Podgoretsky © (09.11.03 19:16) [1]
> Убираем все WriteLn вывода на консоль.

Прикол в том что когда убираю, прога не работает!

---

← →
default   (2003-11-09 19:26) [3]

ты эта...не всё круши-то, вот такие вещи "writeln(sout,s);" не трогай

---

← →
Anatoly Podgoretsky   (2003-11-09 19:39) [4]

Убирать надо только то, что общается с консолью, зачем же табуретки ломать?

---

← →
Anatoly Podgoretsky   (2003-11-09 19:40) [5]

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

---

← →
RoLeX   (2003-11-09 20:12) [6]

> Anatoly Podgoretsky © (09.11.03 19:40) [5]
> Ты бы проконсультировался с автором, прежде чем копировать
> код.

Да пошёл этот автор! Чё он мне сделает?

А echo нада убирать???

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2003.11.20;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.012 c