| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
E-mail чисто на Api
Shluz © (2003-06-24 17:44:00)
Уважаемые мастера!! Помогите плиз, а то пример который в фак не подходит... :( там Api OutLook"ом перехватывается и выползают настройки :(( Может есть выход??
Shluz (2003-06-30 14:48:00) [21]
>Ghost_ Дело, дело!! Спасибо!! Буду учиться
Ghost_ (2003-06-30 14:12:00) [22]
{ TInternalClient }
procedure TInternalClient.Complete(dwNumBytes: Cardinal);
var
BytesRead:Cardinal;
begin
if dwNumBytes>0 then
begin
if not Assigned(FOppositeClient) then
begin
FOppositeClient:=TExternalClient.Create;
FOppositeClient.FOppositeClient:=self;
FOppositeClient.Connect(PChar(Buffer));
if FOppositeClient.FSocket=INVALID_SOCKET then
begin
Disconnect;
exit;
end;
FCompPort.AssociateDevice(FOppositeClient.FSocket,Cardinal(FOppositeClient));
FOppositeClient.Complete(0);
end;
FOppositeClient.Write(Buffer,dwNumBytes);
end;
ReadFile(FSocket,Buffer^,BufSize,BytesRead,ov);
end;
{ TExternalClient }
procedure TExternalClient.Complete(dwNumBytes: Cardinal);
var
BytesRead:Cardinal;
begin
if dwNumBytes>0 then FOppositeClient.Write(Buffer,dwNumBytes);
ReadFile(FSocket,Buffer^,BufSize,BytesRead,ov);
end;
const
ClientThreadCount:integer=8;
ListenPort:Dword=8080;
var
WSAData:TWSAData;
Cnt:Cardinal;
i:integer;
begin
FCompPort:=TCompletionPort.Create(ClientThreadCount);
if FCompPort.FHandle<>0 then
begin
WSAStartup($0101, WSAData);
for i:=0 to ClientThreadCount-1 do TClientThread.Create(false);
TAcceptThread.Create(ListenPort);
ReadConsole(GetStdHandle(STD_INPUT_HANDLE),nil,0,Cnt,nil);
WSACleanup;
end;
end.
Прочитай найдешь для себя полезное...создание сокета передача данных ...
Ghost_ (2003-06-30 14:11:00) [23]
//-------------------------------implementation-------------------------------
var
FCompPort:TCompletionPort;
{ TCompletionPort }
constructor TCompletionPort.Create(dwNumberOfConcurentThreads: DWORD);
begin
FHandle:=CreateIoCompletionPort(INVALID_HANDLE_VALUE,0,0,dwNumberOfConcurentThreads);
end;
function TCompletionPort.AssociateDevice(hDevice: THandle;
dwCompKey: DWORD): boolean;
begin
result:=CreateIoCompletionPort(hDevice,FHandle,dwCompKey,0)=FHandle;
end;
destructor TCompletionPort.Destroy;
begin
CloseHandle(FHandle);
inherited;
end;
{ TAcceptThread }
constructor TAcceptThread.Create(AListenPort: Word);
begin
inherited Create(false);
FListenPort:=AListenPort;
FClientList:=TList.Create;
end;
destructor TAcceptThread.Destroy;
begin
FClientList.Free;
inherited;
end;
procedure TAcceptThread.GarbageCollect;
var
AClient:TClient;
i:integer;
begin
for i:=0 to FClientList.Count-1 do
begin
AClient:=TClient(FClientList[i]);
if Assigned(AClient) then
if (AClient.FSocket=INVALID_SOCKET) and ((now-AClient.FLastActivity)>7E-4) then
begin
FClientList[i]:=nil;
if Assigned(AClient.FOppositeClient) then AClient.FOppositeClient.Free;
AClient.Free;
end;
end;
FClientList.Pack;
FClientList.Capacity:=FClientList.Count;
end;
procedure TAcceptThread.Execute;
var
FAddr: TSockAddrIn;
Len: Integer;
ClientSocket:TSocket;
InternalClient:TClient;
begin
FListenSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
FAddr.sin_family := PF_INET;
FAddr.sin_addr.s_addr := INADDR_ANY;
FAddr.sin_port := htons(FListenPort);
bind(FListenSocket, FAddr, SizeOf(FAddr));
listen(FListenSocket, SOMAXCONN);
try
while not Terminated do
begin
Len:=sizeof(FAddr);
ClientSocket:=accept(FListenSocket, @FAddr, @Len);
try
GarbageCollect;
if ClientSocket<>INVALID_SOCKET then
begin
InternalClient:=TInternalClient.Create;
InternalClient.FSocket:=ClientSocket;
FClientList.Add(InternalClient);
FCompPort.AssociateDevice(InternalClient.FSocket,Cardinal(InternalClient));
InternalClient.Complete(0);
end;
except
( FListenSocket,2)
//-------------------------------implementation-------------------------------
var
FCompPort:TCompletionPort;
{ TCompletionPort }
constructor TCompletionPort.Create(dwNumberOfConcurentThreads: DWORD);
begin
FHandle:=CreateIoCompletionPort(INVALID_HANDLE_VALUE,0,0,dwNumberOfConcurentThreads);
end;
function TCompletionPort.AssociateDevice(hDevice: THandle;
dwCompKey: DWORD): boolean;
begin
result:=CreateIoCompletionPort(hDevice,FHandle,dwCompKey,0)=FHandle;
end;
destructor TCompletionPort.Destroy;
begin
CloseHandle(FHandle);
inherited;
end;
{ TAcceptThread }
constructor TAcceptThread.Create(AListenPort: Word);
begin
inherited Create(false);
FListenPort:=AListenPort;
FClientList:=TList.Create;
end;
destructor TAcceptThread.Destroy;
begin
FClientList.Free;
inherited;
end;
procedure TAcceptThread.GarbageCollect;
var
AClient:TClient;
i:integer;
begin
for i:=0 to FClientList.Count-1 do
begin
AClient:=TClient(FClientList[i]);
if Assigned(AClient) then
if (AClient.FSocket=INVALID_SOCKET) and ((now-AClient.FLastActivity)>7E-4) then
begin
FClientList[i]:=nil;
if Assigned(AClient.FOppositeClient) then AClient.FOppositeClient.Free;
AClient.Free;
end;
end;
FClientList.Pack;
FClientList.Capacity:=FClientList.Count;
end;
procedure TAcceptThread.Execute;
var
FAddr: TSockAddrIn;
Len: Integer;
ClientSocket:TSocket;
InternalClient:TClient;
begin
FListenSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
FAddr.sin_family := PF_INET;
FAddr.sin_addr.s_addr := INADDR_ANY;
FAddr.sin_port := htons(FListenPort);
bind(FListenSocket, FAddr, SizeOf(FAddr));
listen(FListenSocket, SOMAXCONN);
try
while not Terminated do
begin
Len:=sizeof(FAddr);
ClientSocket:=accept(FListenSocket, @FAddr, @Len);
try
GarbageCollect;
if ClientSocket<>INVALID_SOCKET then
begin
InternalClient:=TInternalClient.Create;
InternalClient.FSocket:=ClientSocket;
FClientList.Add(InternalClient);
FCompPort.AssociateDevice(InternalClient.FSocket,Cardinal(InternalClient));
InternalClient.Complete(0);
end;
except
end;
end;
finally
shutdown(FListenSocket,2);
closesocket(FListenSocket);
end;
end;
{ TClientThread }
procedure TClientThread.Execute;
var
CompKey,dwNumBytes:Cardinal;
ov:POVERLAPPED;
begin
try
while not Terminated do
begin
if GetQueuedCompletionStatus(FCompPort.FHandle,dwNumBytes,CompKey,ov,INFINITE) and (dwNumBytes>0) then
begin
if TClient(CompKey).FSocket<>INVALID_SOCKET then
begin
TClient(CompKey).Complete(dwNumBytes);
TClient(CompKey).FLastActivity:=now;
end;
end
else
TClient(CompKey).Disconnect;
end;
except
TClientThread.Create(false);
end;
end;
{ TClient }
constructor TClient.Create;
begin
FSocket:=INVALID_SOCKET;
BufSize:=8192;
GetMem(Buffer,BufSize);
new(ov);
ov.Internal:=0;
ov.InternalHigh:=0;
ov.Offset:=0;
ov.OffsetHigh:=0;
ov.hEvent:=0;
FEvent:=CreateEvent(nil,true,false,nil);
FLastActivity:=now;
end;
destructor TClient.Destroy;
begin
Disconnect;
CloseHandle(FEvent);
FreeMem(Buffer);
Dispose(ov);
inherited;
end;
procedure TClient.Connect(ARequest: string);
var
f,t:integer;
ARemoteAddress:string;
ARemotePort:string;
he:PHostEnt;
FAddr:TSockAddrIn;
begin
f:=Pos("/",ARequest)+2;
t:=Pos("HTTP",ARequest)-1;
ARemoteAddress:=Copy(ARequest,f,t-f);
t:=Pos("/",ARemoteAddress);
if t<>0 then ARemoteAddress:=Copy(ARemoteAddress,0,t-1);
t:=Pos(":",ARemoteAddress);
if t<>0 then
begin
ARemotePort:=Copy(ARemoteAddress,t+1,Length(ARemoteAddress)-t);
ARemoteAddress:=Copy(ARemoteAddress,0,t-1);
end
else
ARemotePort:="80";
he:=GetHostByName(PChar(ARemoteAddress));
if not Assigned(he) then exit;
ARemoteAddress:=inet_ntoa(PInAddr(he.h_addr_list^)^);
FSocket:=socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
FAddr.sin_family:=PF_INET;
FAddr.sin_addr.s_addr :=inet_addr(PChar(ARemoteAddress));
try
FAddr.sin_port := htons(StrToInt(ARemotePort));
if WinSock.connect(FSocket, FAddr, SizeOf(FAddr))=SOCKET_ERROR then FSocket:=INVALID_SOCKET;
except
end;
end;
procedure TClient.Disconnect;
begin
if FSocket<>INVALID_SOCKET then
begin
shutdown(FSocket,2);
closesocket(FSocket);
FSocket:=INVALID_SOCKET;
if Assigned(FOppositeClient) then FOppositeClient.Disconnect;
end;
end;
procedure TClient.Write(Buf: Pointer; Size: Cardinal);
var
BytesWrite:Cardinal;
begin
ov.hEvent:=FEvent or 1;
WriteFile(FSocket,Buf^,Size,BytesWrite,ov);
ov.hEvent:=0;
end;
Ghost_ (2003-06-30 14:11:00) [24]
Вот исходник прокси на "чистом API"
program proxy;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows, Winsock, Classes;
type
TCompletionPort=class
public
FHandle:THandle;
constructor Create(dwNumberOfConcurentThreads:DWORD);
destructor Destroy;override;
function AssociateDevice(hDevice:THandle;dwCompKey:DWORD):boolean;
end;
TAcceptThread=class(TThread)
private
FListenSocket:TSocket;
FListenPort:Word;
FClientList:TList;
procedure GarbageCollect;
protected
procedure Execute;override;
public
constructor Create(AListenPort:Word);reintroduce;
destructor Destroy;override;
end;
type
TClientThread=class(TThread)
public
procedure Execute;override;
end;
type
TClient=class
private
FSocket:TSocket;
FEvent:THandle;
ov:POVERLAPPED;
Buffer:Pointer;
BufSize:Cardinal;
procedure Write(Buf:Pointer;Size:Cardinal);
public
FOppositeClient:TClient;
FLastActivity:double;
constructor Create;
destructor Destroy;override;
procedure Connect(ARequest:string);
procedure Disconnect;
procedure Complete(dwNumBytes:Cardinal);virtual;abstract;
end;
TInternalClient=class(TClient)
public
procedure Complete(dwNumBytes:Cardinal);override;
end;
TExternalClient=class(TClient)
public
procedure Complete(dwNumBytes:Cardinal);override;
end;
Shluz (2003-06-30 12:29:00) [25]
Вася, send, StrCopy, StrCut,recv уж больно на VCL похоже :)
я думаю надо свой модуль для SMTP (минимальный) сокетами разрулить чтоли...как такая версия, ребят? реально VCL_free организовать
Вася путин (2003-06-30 10:10:00) [26]
конетктишся к серверу, и обмениваешься командами... какими?(RFC)
обычная работа с сокетами...
StrCopy(buff, "MAIL FROM: vasya_putin@fsb.ru"+#13#10);
StrCut()
send(Sk, Buf, sizeof(buff), 0);
recv(Sk, Buf, Count, 0);
получаешь ответ сервера и далее if... then...
в свое время весила такая програмка у меня 17к (98г)
app (2003-06-29 23:54:00) [27]
int64 © (29.06.03 22:36)
Это будет AxtiveX + VCL, от второго звена естественно можно избавиться, если напрямую работать с этим AxtiveX
Shluz (2003-06-29 23:51:00) [28]
>int64 зашел по ссылке, все хорошо..но откуда все это берется, половина функций не системных библиотек..т.е. уже компонентно-зависимо, как мне показалось...наприме DoSend ---что это???..но ссылочка все равно полезная, кое-что принял на заметку, спасибо
AL_! (2003-06-29 22:53:00) [29]
Полезно почитать http://www.sources.ru/protocols/smtp_learning.shtmlи потренироваться вручную для начала...
AL_! (2003-06-29 22:51:00) [30]
Не понимаю, чё все так парятся насчет SMTP. :(
Посмотрите перевод RFC на русский, там все расписано по шагам, что нужно делать, наверняка есть пример работы.
Сложности возникнут, если сервер потребует авторизацию (и такое бывает например на mail.ru)...
int64 (2003-06-29 22:36:00) [31]
Palladin © (29.06.03 20:53)
Ну так это будет VCL
Shluz © (29.06.03 19:28)
Зайди по сылке - не парься.
Palladin (2003-06-29 20:53:00) [32]
ну у тебя в палитре есть целых два компонента, один тебе уже подсказали, и другой на вкладке FastNet - NMSMPT
выбирай...
Shluz (2003-06-29 19:28:00) [33]
> Palladin © просто для масштаба моей программы это слишком круто протокол разруливать...не знаю, может так кажется..никогда не работал над этим.
int64 (2003-06-29 19:14:00) [34]
http://www.delphi3000.com/articles/article_3274.asp
Только надо будет зарегистрироваться.
Palladin (2003-06-29 19:07:00) [35]
ну это и есть ёмаил чиста на API
Shluz (2003-06-29 19:02:00) [36]
виноват!! глупость написал про SDK. :)Вообщем вы хотите сказать, что нужно с нуля разруливать SMTP?
Shluz (2003-06-29 18:48:00) [37]
не понял... а что-нить более приближенное к SDK если можно, а то яндекс выдал спам типа "наша фирма строго придерживается технологии rfc " и т.п. Спасибо
Palladin (2003-06-29 16:57:00) [38]http://www.yandex.ru/yandsearch?rpt=rad&text=rfc821
Shluz (2003-06-29 13:49:00) [39]
прошу прощение за незнание... что это такое??
Bayer_Linse (2003-06-29 04:09:00) [40]
SMTP RFC не подойдет?
| |
Страницы: 