Entwickler-Ecke

Internet / Netzwerk - Delphi " Programm" als email senden


Str1ke - Di 15.03.05 18:41
Titel: Delphi " Programm" als email senden
Hey Leute

Ich muss für die Schule en Prog dchreiben, in dem man eingeben muss:
Name
Vorname
Adresse
Plz
etc....

Diese eingebanen werden durch ein Edit Fenster eingelesen, kann mann jetzt machen, dass diese ergebnisse als email versand werden?

Danke im Vorraus,
Str1ke


PS: Hab in der Suchmaschiene etwas über en anderen anbiter gefunden zum senden, des is mir abber zu kompliziert.....^^ sry


MrSaint - Di 15.03.05 19:03

Stichwort Indy Komponenten [http://www.indyproject.org/download/index.iwp]!



MrSaint


Str1ke - Di 15.03.05 19:17

thx abber ich bin eigentlich ziemlich anfänger, kannste mir des en bissle erklären, kapier des net so was diese indy da sein soll *gg*

Bitte


WeBsPaCe - Di 15.03.05 19:17

Und das [http://www.indyproject.org/DemoDownloads/Indy_10_MailClient.zip] ist die passende Demo dazu... ;) (Für Indy10)

//EDIT: Die Indy-Compos sind Komponenten bzw. Indy ist eine Komponentensammlung, also sowas wie der TButton. Nach der Installation gibt's dann oben auch sowas, was IdSMTP heißt. Damit verschickst du eMails.

Am besten lädst du dir einfach mal die Demo da oben runter und schaust, ob du's öffnen kannst. ;) Wenn nicht einfach posten.

//EDIT: (2) Wenn Fehler beim Öffnen von dem Projekt kommen, dann installier einfach mal das: http://downloads.atozedsoftware.com/indy/indy10.0.76_d6.exe


Str1ke - Di 15.03.05 19:29

KK thx,

falls du zeit hast, könntest mir helfen?

Brauch en Formular


name
vorname
Straße
Hausnummer
Postleitzahl

dann hintendran wird des zeug in de edit fenster eingegeben, wenn ich dann auf fertig drücke, soll es an eine email adresse gesendet werden, kasnnt mir helfen des zu programmen?

thx


WeBsPaCe - Di 15.03.05 19:30

:lol: Ja, hast du dir denn dir Demo schon runtergeladen?? Eigentlich hab ich ja schon angefangen dir zu helfen.... :lol: ;)


Str1ke - Di 15.03.05 19:35

jop hab ich abber ich hab nu die delphi 3 sry

wäre echt spitze wennd e mir bitte helfen könntest, ich denke für einen kenner wie dich sind des 10 misn arbeit, bitte


WeBsPaCe - Di 15.03.05 19:38

Delphi 3???

Öhm, soll das ein richtiges Projekt werden oder nur was Kurzes für die Schule?? Weil ansonsten gibt's da die Internet-Komponenten bei Delphi3, da müsste die TPOP3 Komponente drin sein, die aber nur funktioniert, wenn auf den Rechner, wo das Prog läuft auch Delphi 3 installiert ist... ;)


Str1ke - Di 15.03.05 19:40

ne nur ein kurzes schulprog, einfach nur die felder eingeben und per klick verschicken, ganz simples prog


WeBsPaCe - Di 15.03.05 19:42

Bei Delphi 3 gibt es dazu eine Demo. Schau mal in deinem Installationsverzeichnis unter "Demos" und dann Internet oder so... ;)

Btw: Ich tu mal reboot, bin kurz weg.....


Str1ke - Di 15.03.05 19:44

user profile iconStr1ke hat folgendes geschrieben:
ne nur ein kurzes schulprog, einfach nur die felder eingeben und per klick verschicken, ganz simples prog
Ach mit deinem Tasta prob, recht unten in der taskleiste, dteht ja dieses DE oder EN , des sind die sprachen der tastatur.
Wenn de rechtsklick drauf machst und dann einstellungen kommste in ein menü dann kannste infachd iese Englishe tasta löschen


WeBsPaCe - Di 15.03.05 19:46

user profile iconStr1ke hat folgendes geschrieben:
Ach mit deinem Tasta prob, recht unten in der taskleiste, dteht ja dieses DE oder EN , des sind die sprachen der tastatur.
Wenn de rechtsklick drauf machst und dann einstellungen kommste in ein menü dann kannste infachd iese Englishe tasta löschen

*g* Jo, das kenn ich auch... ;) Aber es war nur hier im DF so.. z.B. im Notepad nich... ;) Jetzt geht wieder alles.. ;) Wie sieht's mit der Demo aus??


Str1ke - Di 15.03.05 19:47

Hilft mir net so arg viel, weil meine lehrerin mir net abnimmt das des von mir ist, weil ich des ja eigentlich net reibauen will.

Halt einfach nur wie ich gesagt hab, dass des alles über den button fertig abgespielt wird...


WeBsPaCe - Di 15.03.05 19:48

Hast ja auch nicht direkt die Demo nehmen sollen... :rofl:

Das sollte so ein Beispiel sein... ;) Das funktioniert aber??


Str1ke - Di 15.03.05 19:49

kanns net laufen lassen weil ich eben es 3 er hab und dieses prog das ich dann gezogen hab war nur für 6


Str1ke - Di 15.03.05 19:50

http://server2.webkicks.de/schulband/index.cgi


können wir schneller schreiben


WeBsPaCe - Di 15.03.05 19:51

Neee... *g* Die Demo, die bei Delphi 3 dabei war... ;)


Str1ke - Di 15.03.05 19:52

komm ma bitte übern link in den chat, der mim posten dauert imma so lang


MrSaint - Di 15.03.05 20:02

EIgentlich solltet ihr das schon hier machen, vllt interessiert es später noch jemand, dies ist ja immerhin ein Forum!
Alternative dazu wäre, wenn ihr nachher wenn ihr fertig seid, den Chatlog hier rein stellt...



MrSaint


Str1ke - Mi 16.03.05 19:53

Also wenn ich es fertig hab, stell ich es rein, bzw die lösungswege, aber da zu bedarf es noch an zeit......

Thx cYa


WeBsPaCe - Mi 16.03.05 20:22

Hier mal mein Code... Funktioniert aber irgendwie nicht... :( Vllt. hilft's... ;)


Delphi-Quelltext
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:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, OleCtrls, isp3;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit8: TEdit;
    GroupBox3: TGroupBox;
    Memo1: TMemo;
    SMTP1: TSMTP;
    Edit9: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
SMTP1.RemoteHost := Edit7.Text;
try SMTP1.Connect(SMTP1.RemoteHost, SMTP1.RemotePort);
except ShowMessage('Fehler beim Verbinden mit dem Server.');
Exit;
end;
while SMTP1.Busy do Application.ProcessMessages;
SMTP1.DocInput.Headers.Clear;
SMTP1.DocInput.Headers.Add('To', Edit6.Text);
SMTP1.DocInput.Headers.Add('From', Edit8.Text);
SMTP1.DocInput.Headers.Add('CC''');
SMTP1.DocInput.Headers.Add('Subject', Edit9.Text);
SMTP1.DocInput.Headers.Add('Message-Id', Format('%s_%s_%s', [Application.Title, DateTimeToStr(Now), Edit9.Text]));
SMTP1.DocInput.Headers.Add('Content-Type''TEXT/PLAIN charset=US-ASCII');
SMTP1.SendDoc(SMTP1.URL, SMTP1.DocInput.Headers, 'HALLO MEMO1''''');
while SMTP1.Busy do Application.ProcessMessages;
SMTP1.Quit;
ShowMessage('eMail wurde an '+Edit6.Text+' versendet.');
ShowMessage(SMTP1.URL);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Lines.Add('Vorname: '+Edit1.Text);
Memo1.Lines.Add('Nachname: '+Edit2.Text);
Memo1.Lines.Add('Straße: '+Edit3.Text+' '+Edit4.Text);
Memo1.Lines.Add('Ort: '+Edit5.Text);
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
Memo1.Clear;
Memo1.Lines.Add('Vorname: '+Edit1.Text);
Memo1.Lines.Add('Nachname: '+Edit2.Text);
Memo1.Lines.Add('Straße: '+Edit3.Text+' '+Edit4.Text);
Memo1.Lines.Add('Ort: '+Edit5.Text);
end;

end.


Lesco - Do 24.03.05 20:24

ach mal nebenbei
es gibt auch delphi 7 personal vollkommen umsonst und legal
musste mal hier im forum suchen


WeBsPaCe - Do 24.03.05 21:11

Klar, aber wenn er's für die Schule proggen muss... :roll: :wink:


delphist - Sa 02.04.05 11:10

Folgender C++ Code sollte auch ohne weiteres auf Delphi übertragbar sein, denn für eine Email per SMTP brauch man nicht immer gleich eine Komponente installieren und verwenden.

Quelltext
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:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
#include <winsock2.h>
#include <stdio.h>
#include <iostream>
using namespace std;
//#pragma comment(lib,"wsock32.lib") 

#define EOL  "\r\n"

DWORD smailid;
HANDLE hthr;
const WORD   VERSION_MAJOR  = 1;     
const WORD   VERSION_MINOR  = 1;
int error;
char pszBody[1500];

typedef struct threadd
{
    char name[200];
    char fromid[200];
    char toid[200];
    char serv[200];
    char sub[300];
    char mes[1000];
} TDATA;

void send(char *smtpservr, char *fromname, char *fromid, char *toid,
          char *subject, char *message);
void Check( int iStatus, char *szFunction );
DWORD WINAPI is_ok( LPVOID l);
int sendmail( LPVOID l);

int main()
{
  send("delhpi-forum.de","Name des Absenders","mailfrom@delhpi-forum.de","mailto@delhpi-forum.de",
       "Betreff","Nachricht");
  getchar();
  return 0;
}

void send(char *smtpservr, char *fromname, char *fromid, char *toid, 
          char *subject, char *message)
{
   TDATA td;

  strcpy(td.fromid,fromid); 
  strcpy(td.name ,fromname); 
  strcpy(td.serv ,smtpservr); 
  strcpy(td.toid ,toid); 
  strcpy(td.sub ,subject); 
  strcpy(td.mes ,message);
  cout<<"Email an "<<toid<<" wird versendet . . ."<<endl;

  hthr=CreateThread(NULL,0,is_ok,(LPVOID)&td,CREATE_SUSPENDED,&smailid);   
  SetThreadPriority( hthr, THREAD_PRIORITY_TIME_CRITICAL);   
  ResumeThread(hthr);   
  WaitForSingleObject(hthr, INFINITE);
   
}

DWORD WINAPI is_ok( LPVOID l)
{
  TDATA *d=(TDATA *)l;
  if(sendmail(l)==0)
  cout<<"Versenden abgeschlossen"<<endl;
  else
  cout<<"Versenden gescheitert"<<endl;
  return 0;
}


void Check( int iStatus, char *szFunction )
{   
  if (iStatus != SOCKET_ERROR && iStatus != 0)  return;
  else
  error=1;   
}

int sendmail( LPVOID l)
{
   WSADATA        WSData;
   LPHOSTENT      lpHostEntry;
   LPSERVENT      lpServEntry;
   SOCKADDR_IN    SockAddr;
   SOCKET         hServer;
   int            iProtocolPort;
   char           szSmtpServerName[100], szToAddr[100], szFromAddr[100];
   char           szBuffer[4096], szMsgLine[255];   

   TDATA *d=(TDATA *)l;
   error=0;   

   lstrcpy( szSmtpServerName,d->serv );   
   lstrcpy( szToAddr,   d->toid );
   lstrcpy( szFromAddr,d->fromid );
      
   if ( WSAStartup(MAKEWORD(VERSION_MAJOR, VERSION_MINOR), &WSData) ) 
   {      
      cout<<"Error: Kann Winsock nicht finden"<<endl;             
      return(1);
   }
   
   lpHostEntry = gethostbyname( szSmtpServerName );
   if (lpHostEntry == NULL)    
   {    
      cout<<"Error: Kann den SMTP Server("<<szSmtpServerName<<")" 
            <<"nicht finden "<<endl;       
      return(1);
   }   
   
   hServer = socket( PF_INET, SOCK_STREAM, 0); 
   if (hServer == INVALID_SOCKET) 
   {            
      cout<<"Error: Cannot open mail server socket"<<endl;
      return(1);
   }
   
   lpServEntry = getservbyname( "mail", 0);
   
   if (lpServEntry == NULL)
     iProtocolPort = htons(IPPORT_SMTP);
   else
     iProtocolPort = lpServEntry->s_port;
   
   SockAddr.sin_family = AF_INET;
   SockAddr.sin_port = iProtocolPort;
   SockAddr.sin_addr = *((LPIN_ADDR)*lpHostEntry->h_addr_list);
   
   if (connect( hServer, (PSOCKADDR) &SockAddr, sizeof(SockAddr)))
   {
     cout<<"Error: Connecting to Server socket failed"<<endl;
     return (1);
   }

   Check( recv( hServer, szBuffer, sizeof(szBuffer), 0), "recv() Reply");
   
   wsprintf(szMsgLine,"HELO %s%s","microsoft [111.122.1.12]", EOL);
   Check(send(hServer,szMsgLine,strlen(szMsgLine), 0),"send() HELO");
   Check(recv(hServer,szBuffer,sizeof(szBuffer), 0),"recv() HELO");
   
   wsprintf( szMsgLine,"MAIL FROM:<%s>%s", szFromAddr,EOL);
   Check(send(hServer,szMsgLine,strlen(szMsgLine), 0),"send() MAIL FROM");
   Check(recv(hServer,szBuffer,sizeof(szBuffer), 0),"recv() MAIL FROM");

   wsprintf( szMsgLine,"RCPT TO:<%s>%s", szToAddr, EOL);
   Check(send(hServer,szMsgLine,strlen(szMsgLine),0),"send() RCPT TO");
   Check(recv(hServer,szBuffer,sizeof(szBuffer),0),"recv() RCPT TO");

   wsprintf( szMsgLine,"DATA%s", EOL);
   Check(send(hServer,szMsgLine,strlen(szMsgLine),0),"send() DATA");
   Check(recv(hServer,szBuffer,sizeof(szBuffer),0),"recv() DATA");


   char sdate[70];
   lstrcpy(sdate,"Date: ");
   char s1s[70];
   GetDateFormat(0x409,0,0,"ddd,dd MMM yyyy",s1s,200);
   lstrcat(sdate,s1s);
   lstrcat(sdate," ");
   GetTimeFormat(0x409,0,0,"HH:mm:ss",s1s,200);
   lstrcat(sdate,s1s);
   lstrcat(sdate," PM");

   char header[350];
   lstrcpy(header,"From: ");
   lstrcat(header,d->name );
   lstrcat(header,"<");
   lstrcat(header,d->fromid );
   lstrcat(header,">");
   lstrcat(header,"\r\n");
   lstrcat(header,"To: ");
   lstrcat(header,d->toid );
   lstrcat(header,"\r\n");
   lstrcat(header,"Subject: ");
   lstrcat(header,d->sub );
   lstrcat(header,"\r\n");
   lstrcat(header,sdate);
   lstrcat(header,"\r\n");
   lstrcat(header,"X-Mailer: Delphi-Forum.De Mailer\r\nMIME-Version:1.0\r\nContent-Type:text/plain;\r\n\tcharset=\"iso-8859-1\"\r\nContent-Transfer-Encoding: 7bit\r\n\r\n");
 
   wsprintf( szMsgLine,header);
   Check(send(hServer,szMsgLine,strlen(szMsgLine), 0),"send() header");
   if (error)
   return error;

  lstrcpy(pszBody,d->mes );
  lstrcat(pszBody,"\r\n\r\n");
  Check(send( hServer,pszBody, strlen(pszBody), 0), "send() message");
  wsprintf(szMsgLine,"%s.%s", EOL, EOL);
  Check(send(hServer,szMsgLine, strlen(szMsgLine),0),"send() end-message");
  Check(recv(hServer,szBuffer, sizeof(szBuffer),0),"recv() end-message");
  wsprintf(szMsgLine,"QUIT%s",EOL);
  Check(send(hServer,szMsgLine,strlen(szMsgLine),0),"send() QUIT");
  Check(recv(hServer,szBuffer,sizeof(szBuffer),0),"recv() QUIT");
  closesocket(hServer);
  WSACleanup();
   
return error;
}


Post Scriptum:
Ein Code für Delphi gibt's hier zu bestaunen:
http://www.swissdelphicenter.ch/de/showcode.php?id=2134


Delphi-Quelltext
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:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
unit SMTP_Connections;
// *********************************************************************
//     Unit Name          : SMTP_Connections                           *
//     Author             : Melih SARICA (Non ZERO)                    *
//     Date               : 01/17/2004                                 *
//**********************************************************************

interface

uses
  Classes, StdCtrls;

const
  WinSock = 'wsock32.dll';
  Internet = 2;
  Stream  = 1;
  fIoNbRead = $4004667F;
  WinSMTP = $0001;
  LinuxSMTP = $0002;

type

  TWSAData = packed record
    wVersion: Word;
    wHighVersion: Word;
    szDescription: array[0..256of Char;
    szSystemStatus: array[0..128of Char;
    iMaxSockets: Word;
    iMaxUdpDg: Word;
    lpVendorInfo: PChar;
  end;
  PHost = ^THost;
  THost = packed record
    Name: PChar;
    aliases: ^PChar;
    addrtype: Smallint;
    Length: Smallint;
    addr: ^Pointer;
  end;

  TSockAddr = packed record
    Family: Word;
    Port: Word;
    Addr: Longint;
    Zeros: array[0..7of Byte;
  end;


function WSAStartup(Version:word; Var Data:TwsaData):integer; stdcallfarexternal winsock;
function socket(Family,Kind,Protocol:integer):integer; stdcallfarexternal winsock;
function shutdown(Socket,How:Integer):integer; stdcallfarexternal winsock;
function closesocket(socket:Integer):integer; stdcallfarexternal winsock;
function WSACleanup:integer; stdcallfarexternal winsock;
function bind(Socket:Integer; Var SockAddr:TSockAddr; AddrLen:integer):integer; stdcallfarexternal winsock;
function listen(socket,flags:Integer):integer; stdcallfarexternal winsock;
function connect(socket:Integer; Var SockAddr:TSockAddr; AddrLen:integer):integer; stdcallfarexternal winsock;
function accept(socket:Integer; Var SockAddr:TSockAddr; Var AddrLen:Integer):integer; stdcallfarexternal winsock;
function WSAGetLastError:integer; stdcallfarexternal winsock;
function recv(socket:integer; data:pchar; datalen,flags:integer):integer; stdcallfarexternal winsock;
function send(socket:integer; var data; datalen,flags:integer):integer; stdcallfarexternal winsock;
function gethostbyname(HostName:PChar):PHost; stdcallfarexternal winsock;
function WSAIsBlocking:boolean; stdcallfarexternal winsock;
function WSACancelBlockingCall:integer; stdcallfarexternal winsock;
function ioctlsocket(socket:integer; cmd: Longint; var arg: longint): Integer; stdcallfarexternal winsock;
function gethostname(name:pchar; size:integer):integer; stdcallfarexternal winsock;

procedure _authSendMail(MailServer,uname,upass,mFrom,mFromName,mToName,Subject:string;mto,mbody:TStringList);
function ConnectServer(mhost:string;mport:integer):integer;
function ConnectServerwin(mhost:string;mport:integer):integer;
function DisConnectServer:integer;
function Stat: string;
function SendCommand(Command: String): string;
function SendData(Command: String): string;
function SendCommandWin(Command: String): string;
function ReadCommand: string;
function encryptB64(s:string):string;


var
  mconnHandle: Integer;
  mFin, mFOut: Textfile;
  EofSock: Boolean;
  mactive: Boolean;
  mSMTPErrCode: Integer;
  mSMTPErrText: string;
  mMemo: TMemo;

implementation

uses
  SysUtils, Sockets, IdBaseComponent,
  IdCoder, IdCoder3to4, IdCoderMIME, IniFiles,Unit1;

var
  mClient: TTcpClient;

procedure _authSendMail(MailServer, uname, upass, mFrom, mFromName,
  mToName, Subject: string; mto, mbody: TStringList);
var
  tmpstr: string;
  cnt: Integer;
  mstrlist: TStrings;
  RecipientCount: Integer;
begin
  if ConnectServerWin(Mailserver, 25) = 250 then
  begin
    Sendcommandwin('AUTH LOGIN ');
    SendcommandWin(encryptB64(uname));
    SendcommandWin(encryptB64(upass));
    SendcommandWin('MAIL FROM: ' + mfrom);
    for cnt := 0 to mto.Count - 1 do
      SendcommandWin('RCPT TO: ' + mto[cnt]);
    Sendcommandwin('DATA');
    SendData('Subject: ' + Subject);
    SendData('From: "' + mFromName + '" <' + mfrom + '>');
    SendData('To: ' + mToName);
    SendData('Mime-Version: 1.0');
    SendData('Content-Type: multipart/related; boundary="Esales-Order";');
    SendData('     type="text/html"');
    SendData('');
    SendData('--Esales-Order');
    SendData('Content-Type: text/html;');
    SendData('        charset="iso-8859-9"');
    SendData('Content-Transfer-Encoding: QUOTED-PRINTABLE');
    SendData('');
    for cnt := 0 to mbody.Count - 1 do
      SendData(mbody[cnt]);
    Senddata('');
    SendData('--Esales-Order--');
    Senddata(' ');
    mSMTPErrText := SendCommand(crlf + '.' + crlf);
    try
      mSMTPErrCode := StrToInt(Copy(mSMTPErrText, 13));
    except
    end;
    SendData('QUIT');
    DisConnectServer;
  end;
end;


function Stat: string;
var
  s: string;
begin
  s := ReadCommand;
  Result := s;
end;

function EchoCommand(Command: string): string;
begin
  SendCommand(Command);
  Result := ReadCommand;
end;

function ReadCommand: string;
var
  tmp: string;
begin
  repeat
    ReadLn(mfin, tmp);
    if Assigned(mmemo) then
      mmemo.Lines.Add(tmp);
  until (Length(tmp) < 4or (tmp[4] <> '-');
  Result := tmp
end;

function SendData(Command: string): string;
begin
  Writeln(mfout, Command);
end;

function SendCommand(Command: string): string;
begin
  Writeln(mfout, Command);
  Result := stat;
end;

function SendCommandWin(Command: string): string;
begin
  Writeln(mfout, Command + #13);
  Result := stat;
end;

function FillBlank(Source: string; number: Integer): string;
var
  a: Integer;
begin
  Result := '';
  for a := Length(trim(Source)) to number do
    Result := Result + ' ';
end;

function IpToLong(ip: string): Longint;
var
  x, i: Byte;
  ipx: array[0..3of Byte;
  v: Integer;
begin
  Result := 0;
  Longint(ipx) := 0;
  i := 0;
  for x := 1 to Length(ip) do
    if ip[x] = '.' then
    begin
      Inc(i);
      if i = 4 then Exit;
    end
  else
  begin
    if not (ip[x] in ['0'..'9']) then Exit;
    v := ipx[i] * 10 + Ord(ip[x]) - Ord('0');
    if v > 255 then Exit;
    ipx[i] := v;
  end;
  Result := Longint(ipx);
end;

function HostToLong(AHost: string): Longint;
var
  Host: PHost;
begin
  Result := IpToLong(AHost);
  if Result = 0 then
  begin
    Host := GetHostByName(PChar(AHost));
    if Host <> nil then Result := Longint(Host^.Addr^^);
  end;
end;

function LongToIp(Long: Longint): string;
var
  ipx: array[0..3of Byte;
  i: Byte;
begin
  Longint(ipx) := long;
  Result       := '';
  for i := 0 to 3 do Result := Result + IntToStr(ipx[i]) + '.';
  SetLength(Result, Length(Result) - 1);
end;

procedure Disconnect(Socket: Integer);
begin
  ShutDown(Socket, 1);
  CloseSocket(Socket);
end;

function CallServer(Server: string; Port: Word): Integer;
var
  SockAddr: TSockAddr;
begin
  Result := socket(Internet, Stream, 0);
  if Result = -1 then Exit;
  FillChar(SockAddr, SizeOf(SockAddr), 0);
  SockAddr.Family := Internet;
  SockAddr.Port := swap(Port);
  SockAddr.Addr := HostToLong(Server);
  if Connect(Result, SockAddr, SizeOf(SockAddr)) <> 0 then
  begin
    Disconnect(Result);
    Result := -1;
  end;
end;

function OutputSock(var F: TTextRec): Integer; far;
begin
  if F.BufPos <> 0 then
  begin
    Send(F.Handle, F.BufPtr^, F.BufPos, 0);
    F.BufPos := 0;
  end;
  Result := 0;
end;

function InputSock(var F: TTextRec): Integer; far;
var
  Size: Longint;
begin
  F.BufEnd := 0;
  F.BufPos := 0;
  Result := 0;
  repeat
    if (IoctlSocket(F.Handle, fIoNbRead, Size) < 0then
    begin
      EofSock := True;
      Exit;
    end;
  until (Size >= 0);
  F.BufEnd := Recv(F.Handle, F.BufPtr, F.BufSize, 0);
  EofSock  := (F.Bufend = 0);
end;


function CloseSock(var F: TTextRec): Integer; far;
begin
  Disconnect(F.Handle);
  F.Handle := -1;
  Result   := 0;
end;

function OpenSock(var F: TTextRec): Integer; far;
begin
  if F.Mode = fmInput then
  begin
    EofSock := False;
    F.BufPos := 0;
    F.BufEnd := 0;
    F.InOutFunc := @InputSock;
    F.FlushFunc := nil;
  end
  else
  begin
    F.Mode := fmOutput;
    F.InOutFunc := @OutputSock;
    F.FlushFunc := @OutputSock;
  end;
  F.CloseFunc := @CloseSock;
  Result := 0;
end;

procedure AssignCrtSock(Socket:integer; Var Input,Output:TextFile);
 begin
  with TTextRec(Input) do
  begin
    Handle := Socket;
    Mode := fmClosed;
    BufSize := SizeOf(Buffer);
    BufPtr := @Buffer;
    OpenFunc := @OpenSock;
  end;
  with TTextRec(Output) do
  begin
    Handle := Socket;
    Mode := fmClosed;
    BufSize := SizeOf(Buffer);
    BufPtr := @Buffer;
    OpenFunc := @OpenSock;
  end;
  Reset(Input);
  Rewrite(Output);
 end;

function ConnectServer(mhost: string; mport: Integer): Integer;
var
  tmp: string;
begin
  mClient := TTcpClient.Create(nil);
  mClient.RemoteHost := mhost;
  mClient.RemotePort := IntToStr(mport);
  mClient.Connect;
  mconnhandle := callserver(mhost, mport);
  if (mconnHandle<>-1then
  begin
    AssignCrtSock(mconnHandle, mFin, MFout);
    tmp := stat;
    tmp := SendCommand('HELO bellona.com.tr');
    if Copy(tmp, 13) = '250' then
    begin
      Result := StrToInt(Copy(tmp, 13));
    end;
  end;
end;

function ConnectServerWin(mhost: string; mport: Integer): Integer;
var
  tmp: string;
begin
  mClient := TTcpClient.Create(nil);
  mClient.RemoteHost := mhost;
  mClient.RemotePort := IntToStr(mport);
  mClient.Connect;
  mconnhandle := callserver(mhost, mport);
  if (mconnHandle<>-1then
  begin
    AssignCrtSock(mconnHandle, mFin, MFout);
    tmp := stat;
    tmp := SendCommandWin('HELO bellona.com.tr');
    if Copy(tmp, 13) = '250' then
    begin
      Result := StrToInt(Copy(tmp, 13));
    end;
  end;
end;

function DisConnectServer: Integer;
begin
  closesocket(mconnhandle);
  mClient.Disconnect;
  mclient.Free;
end;

function encryptB64(s: string): string;
var
  hash1: TIdEncoderMIME;
  p: string;
begin
  if s <> '' then
  begin
    hash1 := TIdEncoderMIME.Create(nil);
    p := hash1.Encode(s);
    hash1.Free;
  end;
  Result := p;
end;

end.

{***************************************************}
{ How to use it / Wie verwende ich die Unit?}
{***************************************************}

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  SMTP_Connections;

procedure TForm1.Button1Click(Sender: TObject);
var
  mto, mbody: TStringList;
  MailServer, uname, upass, mFrom, mFromName,
  mToName, Subject: string;
begin
  mMemo := Memo1; // to output server feedback
  //..........................
  MailServer := 'mail.xyz.net';
  uname := 'username';
  upass := 'password';
  mFrom :=  'user@xyz.net';
  mFromName := 'forename surname';
  mToName := '';
  Subject := 'Your Subject';
  //..........................
  mto := TStringList.Create;
  mbody := TStringList.Create;
  try
    mto.Add('anybody@xyz.net');
    mbody.Add('Test Mail');
    //Send Mail.................
    _authSendMail(MailServer, uname, upass, mFrom, mFromName, mToName, Subject, mto, mbody);
    //..........................
  finally
    mto.Free;
    mbody.Free;
  end;
end;

end.


WeBsPaCe - Sa 02.04.05 11:35

Stimmt. Man kann auch einfach ein TSocket auf 25 (SMTP??) connecten und dann PlainText senden. Werd ich mal nach den Whitepapers suchen. ;)