www.pudn.com > mail104s.lzh > INSOCKET.PAS
(*----------------------------------------------------------*)
(* 宣告一 Winsock的副程式 *)
(* 版本 1.01 *)
(* 日期 07 /06 /96 *)
(* 用途 SMTP POP *)
(*----------------------------------------------------------*)
unit INSocket;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, NWinSock;
const
UDF_SOCKETEVENT=WM_USER+500;
UDF_HOSTLOOKUP=WM_USER+501;
MAIL_NOOP = 0;
MAIL_CONNECT = 1;
MAIL_HELO = 2;
MAIL_MAILFROM = 3;
MAIL_RCPTTO = 4;
MAIL_RCPTCC = 5;
MAIL_DATA = 6;
MAIL_RSET = 7;
MAIL_SEND = 8;
MAIL_SOML = 9;
MAIL_SAML = 10;
MAIL_VRFY = 11;
MAIL_EXPN = 12;
MAIL_HELP = 13;
MAIL_TURN = 14;
MAIL_QUIT = 15;
MAIL_SENDINGHEADER = 16;
MAIL_SENDINGMESSAGE = 17;
{ pop Message }
MAIL_USER =18;
MAIL_PASS =19;
MAIL_STAT =20;
MAIL_LIST =21;
MAIL_RETR =22;
MAIL_DELE =23;
MAIL_APOP =25;
MAIL_TOP =26;
MAIL_UIDL =27;
type
TSock=Class(TObject)
public
function StartSocket:Boolean;
function CreateSocket:TSocket;
procedure GetHostAddr(Wnd: THandle; pMsg: Word; tHostName: String);
function GetHostAddressString: String;
function HostEntryVrify:Boolean;
function OpenSocketConnection(Wnd: THandle; pMsg: Word; PortN: Integer): TSOCKET;
procedure CloseSocketConnection(DeadSocket: TSocket);
procedure ShutdownSocket;
procedure SocketSend(SendSocket:TSocket; Wnd: THandle; pMsg: Word; sSendStr: pChar);
private
INetHostEntry:PHostEnt;
(* 主機的 Internet IP *)
INetHostIPAddr:PChar;
(* 主機的 Windows Socket 資訊 *)
HostSockData:TWSADATA;
public
CodeFlag:Integer;
end;
procedure Empty(Ptr:pchar;Length:Integer);
function ReadALine(Dest:pChar;Src:pChar):boolean;
(*----------------------------------------------------------*)
(* 可執行程式碼 *)
(*----------------------------------------------------------*)
implementation
var
ISP_Host:PChar;
INet_buf:PChar;
(* 本地端的 SockAddressIn 結構 *)
LocalSocketAddr: TSockaddrin;
(* 主機端的 SocketAddressIn 結構 *)
HostSocketAddr: TSockaddrin;
// Modify at 04/08 use this flag to decide the
// UUCPForm on form active event to execute which
// mode to encode, which mode to decode.
(*----------------------------------------------------------*)
(* 用途 :初始化 Socket 載入 Winsock.DLL *)
(*----------------------------------------------------------*)
function TSock.StartSocket:Boolean;
var
Ver:Word ;
WSockInfo:TWSADATA;
Err:Integer;
begin
Ver:=$0101;
Err:=WSAStartup(Ver,WSockInfo);
case Err of
WSAEINVAL : StartSocket:= False;
WSASYSNOTREADY : StartSocket := False;
WSAVERNOTSUPPORTED: StartSocket := False;
else
StartSocket:=True;
end;
end;
(*----------------------------------------------------------*)
(* 用途 :啟動 socket *)
(* 參數 :無 *)
(* 傳回 :正在動作的 socket代碼 *)
(*----------------------------------------------------------*)
function TSock.CreateSocket:TSocket;
var
NewSocket:TSocket ;
begin
(* 指定它是一個 Internet的 Protocol family 及 socket的 type *)
NewSocket := socket(PF_INET, SOCK_STREAM, 0);
if NewSocket=INVALID_SOCKET then
ShowMessage('Socket 處理失敗')
else
Result:=NewSocket;
end;
(*----------------------------------------------------------*)
(* 取得主機的位址 *)
(* 參數: hWnd :THandle *)
(* HostName:string *)
(* wMsg :Word *)
(* SockStatus:Integer *)
(*----------------------------------------------------------*)
procedure TSock.GetHostAddr(Wnd: THandle; pMsg: Word; tHostName: String);
var
NewHandle:THandle;
begin
StrDispose(ISP_Host);
ISP_Host:=StrAlloc(Length(tHostName)+1);
StrPCopy(ISP_Host,tHostName);
(* 取得主機的 Network IP *)
(* 如果INet_Buf己被分配記憶體 則釋放 *)
StrDispose(INet_Buf);
INet_Buf := StrAlloc((MAXGETHOSTSTRUCT + 1));
{Request the host address}
NewHandle := WSAAsyncGetHostByName(Wnd, pMsg, ISP_Host, INet_Buf,
(MAXGETHOSTSTRUCT + 1));
if (NewHandle = 0) then
ShowMessage('取得主機位址失敗');
end;
(*----------------------------------------------------------*)
(* 轉換主機位址為 IP Address 字串 xxx.xxx.xxx.xxx *)
(* 傳回值 :IP String *)
(*----------------------------------------------------------*)
function TSock.HostEntryVrify:Boolean;
var
Leng:Integer;
begin
{Cast the host address buffer as a THostEnt record}
INetHostEntry :=PHostEnt(INet_Buf);
{Check the length of the address}
if (INetHostEntry^.h_length <= 0) then
Result := FALSE
else begin
Leng := StrLen(INetHostEntry^.h_addr_list^);
StrDispose(INetHostIPAddr);
if (Leng < INetHostEntry^.h_length) then
INetHostIPAddr := StrAlloc(Leng)
else
INetHostIPAddr := StrAlloc(INetHostEntry^.h_length + 1);
{Copy the new addresses into the new memory}
StrLCopy(INetHostIPAddr, PChar(INetHostEntry^.h_addr_list^), INetHostEntry^.h_length);
INetHostIPAddr[INetHostEntry^.h_length] := Char(0);
Result := TRUE;
end;
end;
(*----------------------------------------------------------*)
(* 轉換主機位址為 IP Address 字串 xxx.xxx.xxx.xxx *)
(* 傳回值 :IP String *)
(*----------------------------------------------------------*)
function TSock.GetHostAddressString: String;
var
IPString:string;
begin
IPString := IntToStr(Integer(INetHostIPAddr[0])) + '.' +
IntToStr(Integer(INetHostIPAddr[1])) + '.' +
IntToStr(Integer(INetHostIPAddr[2])) + '.' +
IntToStr(Integer(INetHostIPAddr[3]));
Result:=IPString;
end;
(*----------------------------------------------------------*)
(* 用途 :開始連線 *)
(* 參數 :hWnd :THandle 視窗的代碼 *)
(* :wMsg :Word 視窗訊息 *)
(* :State:Integer Socket的狀態 *)
(* :PortN:Integer *)
(* 傳回值 :TSocket *)
(*----------------------------------------------------------*)
function TSock.OpenSocketConnection(Wnd: THandle; pMsg: Word; PortN: Integer): TSOCKET;
var
ActSocket:TSocket; (* 要執行的 Socket代碼 *)
HostAddrStr:string; (* 主機位址 Pascal字串 *)
PHostAddrStr:pChar; (* 主機位址字串 C Style *)
HostINetAddL:LongInt; (* Internet主機位址 LongInt *)
begin
(* 設定 TSockAddrin *)
ActSocket:=CreateSocket;
if ActSocket<>INVALID_SOCKET then
begin
(* 轉換 Host 之 IP為 xxx.xxx.xxx.xxx *)
HostAddrStr := GetHostAddressString;
(* 轉成 C語言的 字串格式 *)
PHostAddrStr := StrAlloc(Length(HostAddrStr) + 1);
StrPCopy(PHostAddrStr, HostAddrStr);
(* 轉換 Internet的主機位址格式 -長整數 *)
HostINetAddL := inet_addr(PHostAddrStr);
StrDispose(PHostAddrStr);
(* 填入本地端的 Socket的 sin結構 *)
LocalSocketAddr.sin_family := AF_INET;
LocalSocketAddr.sin_port := htons(PortN);
localSocketAddr.sin_addr.s_addr := HostINetAddL;
localSocketAddr.sin_zero[0] := Char(0);
(* 設定非同步的讀取與寫入 *)
WSAAsyncSelect(ActSocket, Wnd, pMsg, FD_CONNECT or FD_WRITE or FD_READ or FD_CLOSE);
(* 連線 *)
if (connect(ActSocket, localSocketAddr, 16) = SOCKET_ERROR) then
begin
if (WSAGetLastError <> WSAEWOULDBLOCK) then
ShowMessage( ' Socket 連線失敗');
end;
end;
Result:=ActSocket;
end;
(*----------------------------------------------------------*)
(* 用途 :關閉 Socket的連線 *)
(* 參數 :TSocket *)
(*----------------------------------------------------------*)
procedure TSock.CloseSocketConnection(DeadSocket: TSOCKET);
begin
closesocket(DeadSocket);
end;
(*----------------------------------------------------------*)
(* 用途 :釋放動態連結 *)
(* 參數 :無 *)
(*----------------------------------------------------------*)
procedure TSock.ShutdownSocket;
begin
{Close and shutdown the WinSock services}
WSACancelBlockingCall;
WSACleanup;
end;
(*----------------------------------------------------------*)
(* 用途 :送資料給對方的 Socket *)
(* 參數 :TSocket *)
(*----------------------------------------------------------*)
{This procedure sends a message over a open socket connection}
procedure TSock.SocketSend(SendSocket:TSocket;Wnd:THandle;pMsg:Word;sSendStr:pChar);
{ Modify send Char Buffer }
{procedure SocketSend(SendSocket: TSocket; Wnd: THandle; pMsg: Word; sSendStr: String);}
var
BytesSent: Integer;
begin
{Convert the string into a null-terminated string (PChar), adding a
carrage-return/new-line on the end}
BytesSent := send(SendSocket, sSendStr, StrLen(sSendStr), 0);
if (BytesSent = SOCKET_ERROR) then
if (WSAGetLastError <> WSAEWOULDBLOCK) then
ShowMessage('Socket 傳送失敗');
end;
{ The function used clear receive buffer from socket }
procedure Empty(Ptr:pchar;Length:Integer);
var
I:Integer;
NullChar:Char;
begin
I:=0;
NullChar:=Char(0);
while(IChar(0)) and (Src[I]<>Char(13))) do
begin
Dest[I]:=Src[I];
inc(I);
end;
Dest[I]:=Char(0);
{ Second Check the first char of source string is #13#10 }
if Src[I]=Char(13) then begin
if Src[I+1]=Char(10) then begin
While Src[I+2]<>Char(0) do
begin
Src[J]:=Src[I+2];
inc(I);
inc(J);
end;
Src[J]:=Char(0);
Result:=True;
end else begin
Src[0]:=Char(0);
Result:=False;
end;
end else begin
Src[0]:=Char(0);
Result:=False;
end;
end;
// Write a function to replace to recv , check receive data
// with end line #0D#0A
end.