Autor Beitrag
WeBsPaCe
ontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic starofftopic star
Beiträge: 2322
Erhaltene Danke: 1

FireFox 3, Internet Explorer 6 SP1
D1, D3Prof, D6Pers, D7Pers+Indy, VisualStudio Express
BeitragVerfasst: Mi 16.03.05 20:22 
Hier mal mein Code... Funktioniert aber irgendwie nicht... :( Vllt. hilft's... ;)

ausblenden volle Höhe 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
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 42



BeitragVerfasst: 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
ontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic starofftopic star
Beiträge: 2322
Erhaltene Danke: 1

FireFox 3, Internet Explorer 6 SP1
D1, D3Prof, D6Pers, D7Pers+Indy, VisualStudio Express
BeitragVerfasst: Do 24.03.05 21:11 
Klar, aber wenn er's für die Schule proggen muss... :roll: :wink:
delphist
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 64

WIN XP, 98, 95; SUSE LINUX 8.1, 6.1, 6.0

BeitragVerfasst: 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.
ausblenden volle Höhe 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:
www.swissdelphicente...showcode.php?id=2134

ausblenden volle Höhe 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.

_________________
3w + freehostlist + de
3w + bild-stoerung + de


Zuletzt bearbeitet von delphist am Sa 02.04.05 11:50, insgesamt 1-mal bearbeitet
WeBsPaCe
ontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic starofftopic star
Beiträge: 2322
Erhaltene Danke: 1

FireFox 3, Internet Explorer 6 SP1
D1, D3Prof, D6Pers, D7Pers+Indy, VisualStudio Express
BeitragVerfasst: 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. ;)