有谁做过WINSOKET？最好能给一个详细的例子，非常急迫啊。

Question

如题。

Answer 1

Send e-mails via WinSock API ? 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..256] of Char; 
    szSystemStatus: array[0..128] of 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..7] of Byte; 
  end; 
function WSAStartup(Version:word; Var Data:TwsaData):integer; stdcall; far; external winsock; 
function socket(Family,Kind,Protocol:integer):integer; stdcall; far; external winsock; 
function shutdown(Socket,How:Integer):integer; stdcall; far; external winsock; 
function closesocket(socket:Integer):integer; stdcall; far; external winsock; 
function WSACleanup:integer; stdcall; far; external winsock; 
function bind(Socket:Integer; Var SockAddr:TSockAddr; AddrLen:integer):integer; stdcall; far; external winsock; 
function listen(socket,flags:Integer):integer; stdcall; far; external winsock; 
function connect(socket:Integer; Var SockAddr:TSockAddr; AddrLen:integer):integer; stdcall; far; external winsock; 
function accept(socket:Integer; Var SockAddr:TSockAddr; Var AddrLen:Integer):integer; stdcall; far; external winsock; 
function WSAGetLastError:integer; stdcall; far; external winsock; 
function recv(socket:integer; data:pchar; datalen,flags:integer):integer; stdcall; far; external winsock; 
function send(socket:integer; var data; datalen,flags:integer):integer; stdcall; far; external winsock; 
function gethostbyname(HostName:PChar):PHost; stdcall; far; external winsock; 
function WSAIsBlocking:boolean; stdcall; far; external winsock; 
function WSACancelBlockingCall:integer; stdcall; far; external winsock; 
function ioctlsocket(socket:integer; cmd: Longint; var arg: longint): Integer; stdcall; far; external winsock; 
function gethostname(name:pchar; size:integer):integer; stdcall; far; external 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, 1, 3)); 
    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) < 4) or (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..3] of 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..3] of 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;

Answer 2

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) < 0) then 
    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<>-1) then 
  begin 
    AssignCrtSock(mconnHandle, mFin, MFout); 
    tmp := stat; 
    tmp := SendCommand('HELO bellona.com.tr'); 
    if Copy(tmp, 1, 3) = '250' then 
    begin 
      Result := StrToInt(Copy(tmp, 1, 3)); 
    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<>-1) then 
  begin 
    AssignCrtSock(mconnHandle, mFin, MFout); 
    tmp := stat; 
    tmp := SendCommandWin('HELO bellona.com.tr'); 
    if Copy(tmp, 1, 3) = '250' then 
    begin 
      Result := StrToInt(Copy(tmp, 1, 3)); 
    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 :=  '[email protected]'; 
  mFromName := 'forename surname'; 
  mToName := ''; 
  Subject := 'Your Subject'; 
  //.......................... 
  mto := TStringList.Create; 
  mbody := TStringList.Create; 
  try 
    mto.Add('[email protected]'); 
    mbody.Add('Test Mail'); 
    //Send Mail................. 
    _authSendMail(MailServer, uname, upass, mFrom, mFromName, mToName, Subject, mto, mbody); 
    //.......................... 
  finally 
    mto.Free; 
    mbody.Free; 
  end; 
end; end.

Answer 3

http://www.yesky.com/SoftChannel/72351167954485248/20000830/109921.shtml

Answer 4

非常感谢AIIRII！
是我没有说清楚，我只是想得到简单的从服务器和客户端进行上传和下载文件的功能，
能帮我吗？

Answer 5

我现在能用CLIENTSOCKET 和SERVERSOCKET进行简单的字符传通信，但如何才能进行文件拷贝呢？我知道要用到文件流，但具体怎样用一时弄不清楚，谁能HELP ME ？WHO CAN？THANK YOU。