Ftpsock.pas
Материал из DRKB
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.