Исходники и листинги ::: Delphi ::: MailSender
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
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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
  Library EMailSND;
  uses
    CrtSock, SysUtils, Windows;
  type TAByte = array [0..maxInt-1] of byte;
       TPAByte = ^TAByte;
  var
   host:integer;
   sin,sout:TextFile;
   sHost, sFrom, sTo, sCc, sType, sSubject, sBody,
   boundary, s, us:string;
   p:integer;
  function Encode(data:string) : string; overload;
  const b64 : array [0..63] of char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  var
    ic,len : integer;
    pi, po : TPAByte;
    c1 : dword;
  begin
   len:=length(data);
   if len > 0 then begin
   SetLength(result, ((len + 2) div 3) * 4);
   pi := pointer(data);
   po := pointer(result);
   for ic := 1 to len div 3 do
   begin
    c1 := pi^[0] shl 16 + pi^[1] shl 8 + pi^[2];
    po^[0] := byte(b64[(c1 shr 18) and $3f]);
    po^[1] := byte(b64[(c1 shr 12) and $3f]);
    po^[2] := byte(b64[(c1 shr 6) and $3f]);
    po^[3] := byte(b64[(c1 ) and $3f]);
    inc(dword(po), 4);
    inc(dword(pi), 3);
   end;
   case len mod 3 of
   1 : begin
        c1 := pi^[0] shl 16;
        po^[0] := byte(b64[(c1 shr 18) and $3f]);
        po^[1] := byte(b64[(c1 shr 12) and $3f]);
        po^[2] := byte('=');
        po^[3] := byte('=');
       end;
   2 : begin
        c1 := pi^[0] shl 16 + pi^[1] shl 8;
        po^[0] := byte(b64[(c1 shr 18) and $3f]);
        po^[1] := byte(b64[(c1 shr 12) and $3f]);
        po^[2] := byte(b64[(c1 shr 6) and $3f]);
        po^[3] := byte('=');
       end;
    end;
   end else
   result := '';
  end;
  procedure Wait(code:char);
  begin
   Readln(sin,s);
  end;
  procedure Echo(s:string);
  begin
   writeln(sout,s);
  end;
  function Include(FileName: string): string;
  var
    f: TextFile;
    s, res: string;
  begin
   res := '';
   {$I-}
   try
   assignfile (f, FileName);
   reset (f);
   while not EOF(f) do
   begin
    readln (f, s);
    res := res + s;
   end;
   closefile (f);
   except
   end;
   {$I+}
   Result := res;
  end;
  procedure SendMail (tHost, ToA, FromA, tCc, Subject, Body, Attachment,
                        Login, Password, Session: string);
  begin
    FileMode:=0;
    sHost := tHost;
    sFrom := FromA;
    sTo := ToA;
    sCc := tCc;
    sSubject:= Subject;
    sBody := Body+#13+Include(Attachment);
    host:=CallServer(sHost,25);
    if host=-1 then
    while host = -1 do
    begin
     host:=CallServer(sHost,25);
     sleep (5000);
    end;
    sleep (1000);
    AssignCrtSock(host,sin,sout);
    Wait('2');
    sleep (1000);
    Echo('EHLO '+Session);
    Wait('2');
    Wait('2');
    Wait('2');
    Wait('2');
    Wait('2');
    sleep (1000);
    Echo('RSET');
    Wait('2');
    sleep (1000);
    Echo('AUTH LOGIN');
    Wait('3');
    sleep (1000);
    Echo(encode(Login));
    Wait('3');
    sleep (1000);
    Echo(encode(Password));
    Wait('2');
    sleep (1000);
  &nbsp;&nbsp;Echo('MAIL From:<'+sFrom+'>');
  &nbsp;&nbsp;Wait('2');
  &nbsp;&nbsp;sleep (1000);
  &nbsp;&nbsp;Echo('RCPT To:<'+sTo+'>');
  &nbsp;&nbsp;Wait('2');
  &nbsp;&nbsp;sleep (1000);
  &nbsp;&nbsp;Echo('DATA');
  &nbsp;&nbsp;Wait('3');
  &nbsp;&nbsp;sleep (1000);
  &nbsp;&nbsp;Echo('From: '+sFrom);
  &nbsp;&nbsp;sleep (1000);
  &nbsp;&nbsp;Echo('To: '+sTo);
  &nbsp;&nbsp;sleep (1000);
  &nbsp;&nbsp;if sCc<>'' then Echo('Cc: '+sCc);
  &nbsp;&nbsp;if sType<>'' then Echo('MIME-Version: 1.0'#13#10'Content-Type: '+sType+';'#13#10#9'boundary="'+boundary+'"');
  &nbsp;&nbsp;Echo('Subject: '+sSubject+#13#10);
  &nbsp;&nbsp;sleep (1000);
  &nbsp;&nbsp;WriteLn(sout,sBody);
  &nbsp;&nbsp;sleep (1000);
  &nbsp;&nbsp;if sType<>'' then Echo(#13#10'--'+boundary+'--'#13#10);
  &nbsp;&nbsp;Echo('.');
  &nbsp;&nbsp;Wait('2');
  &nbsp;&nbsp;sleep (1000);
  &nbsp;&nbsp;Echo('QUIT');
  &nbsp;&nbsp;Wait('2');
  &nbsp;&nbsp;Close(Input);
  end;
  exports SendMail;
  begin
  end.
<<< Предыдущая работа

Вернуться в галерею исходников 		MailSender
Автор: Moonglow*
Город: Бабруйск
 Дата: 22.01.2007  12:56
Комментариев: 0
Просмотров: 176
Оценка: 0 (0|0|0|0|0) [0]
Вернуться на главную
Авторский комментарий к работе: Пример отправки почты с авторизацией на сервере. Для работы необходима CRTSOCK от мелкософта. Написано на Апи, библиотека.
Вы не можете оценивать

КОММЕНТАРИИ К РАБОТЕ:
Нет комментариев