Ftpsock.pas

unit FtpSock;
{
 CrtSocket for Delphi 32
 Copyright (C) 1999-2001 Paul Toth <tothpaul@free.fr>
 http://tothpaul.free.fr
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
interface
uses
 CrtSock, SysUtils;
function FtpLogon(Server, User, Password: string): Integer;
procedure FtpLogoff;
function FtpQuote(cmd: string): Boolean;
function FtpOpenWrite(FileName: string): Integer;
function FtpOpenRead(FileName: string): Integer;
function FtpClose(FileHandle: Integer): Boolean;
function FtpError: string;
implementation
var
 ftpin, ftpout: TextFile;
 last: string;
 Read: Boolean;
function FtpError: string;
begin
 Result := last;
end;
function ReadString: string;
begin
 repeat
 ReadLn(ftpin, Result);
 // writeln(result);
 until (Length(Result) < 4) or (Result[4] <> '-');
 last := Result;
end;
procedure WriteString(s: string);
begin
 // writeln('>>>',s);
 WriteLn(ftpout, s);
end;
function Status: Char;
var
 s: string;
begin
 s := ReadString;
 if s = then Status := '?'
 else
 Status := s[1];
end;
function Exec(cmd: string): Char;
begin
 WriteString(cmd);
 Result := Status;
end;
function FtpLogon(Server, User, Password: string): Integer;
begin
 Result := CallServer(Server, 21);
 if Result > 0 then
 begin
 AssignCrtSock(Result, ftpin, ftpout);
 if Status = '2' then
 begin
 if (Exec('USER ' + User) = '3') and (Exec('PASS ' + Password) = '2') then exit;
 Disconnect(Result);
 Result := -3;
 end
 else
 begin
 Disconnect(Result);
 Result := -2;
 end;
 end;
end;
procedure FtpLogoff;
begin
 Exec('QUIT');
 CloseFile(ftpout);
end;
function FtpQuote(cmd: string): Boolean;
begin
 WriteString(Cmd);
 Result := (Status = '2');
end;
function GetValue(var s: string): Integer;
var
 i: Integer;
begin
 i := Length(s);
 while s[i] <> ',' do Dec(i);
 Result := StrToInt(Copy(s, i + 1, 3));
 SetLength(s, i - 1);
end;
function FtpOpenWrite(FileName: string): Integer;
var
 s: string;
 b, e: Integer;
 port: Word;
begin
 Read := False;
 Result := -1;
 if Exec('PASV') <> '2' then exit;
 b := 4;
 while (b < Length(last)) and (not (last[b] in ['0'..'9'])) do Inc(b);
 e := Length(last);
 while (e > 0) and (not (last[b] in ['0'..'9'])) do Dec(b);
 s := Copy(last, b, e - b - 1);
 port := GetValue(s);
 port := 256 * GetValue(s) + port;
 for e := 1 to Length(s) do if s[e] = ',' then s[e] := '.';
 // replace "," by "." in IP address
 WriteString('STOR ' + FileName);
 // writeln('call ',s,':',port);
 Result := CallServer(s, port);
 if (Status <> '1') and (Result >= 0) then
 begin
 Disconnect(Result);
 Result := -1;
 end;
end;
function FtpOpenRead(FileName: string): Integer;
var
 s: string;
 b, e: Integer;
 port: Word;
begin
 Read := True;
 Result := -1;
 if Exec('PASV') <> '2' then exit;
 b := 4;
 while (b < Length(last)) and (not (last[b] in ['0'..'9'])) do Inc(b);
 e := Length(last);
 while (e > 0) and (not (last[b] in ['0'..'9'])) do Dec(b);
 s := Copy(last, b, e - b - 1);
 port := GetValue(s);
 port := 256 * GetValue(s) + port;
 for e := 1 to Length(s) do if s[e] = ',' then s[e] := '.';
 // replace "," by "." in IP address
 WriteString('RETR ' + FileName);
 Result := CallServer(s, port);
 if (Status <> '1') and (Result >= 0) then
 begin
 Disconnect(Result);
 Result := -1;
 end;
end;
function FtpClose(FileHandle: Integer): Boolean;
begin
 Disconnect(FileHandle);
 Result := Status = '2';
end;
end.
Category:Связь
Category:Сокеты