Mam problem z serwerem FTP
Zrobiłem sobie serwer ftp i on niby działa ale jak się rozłanczam z serwerem przez klienta (TotalComander[FTP]) to wyskakuje mi niebieski ekran śmierci,
tak jakby nie było jakieś procedury odłączającej klięnta?
oto kod mojego programu:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
IdBaseComponent, IdComponent, IdTCPServer, IdFTPList,
IdFTPServer, StdCtrls, ComCtrls, Grids,
DirOutln, ExtCtrls, Buttons, IdUDPBase,
IdUDPServer, IdTrivialFTPServer, IdIntercept, IdLogBase, IdLogEvent,
IdTCPConnection, IdTCPClient, IdFTP;
type
TForm1 = class(TForm)
FTP: TIdFTPServer;
procedure FTPAfterUserLogin(ASender: TIdFTPServerThread);
procedure FTPUserLogin(ASender: TIdFTPServerThread;
const AUsername, APassword: String; var AAuthenticated: Boolean);
procedure FTPStoreFile(ASender: TIdFTPServerThread;
const AFileName: String; AAppend: Boolean; var VStream: TStream);
procedure FTPRetrieveFile(ASender: TIdFTPServerThread;
const AFileName: String; var VStream: TStream);
procedure FTPChangeDirectory(ASender: TIdFTPServerThread;
var VDirectory: String);
procedure FTPListDirectory(ASender: TIdFTPServerThread;
const APath: String; ADirectoryListing: TIdFTPListItems);
procedure FTPMakeDirectory(ASender: TIdFTPServerThread;
var VDirectory: String);
procedure FTPStatus(ASender: TObject;
const AStatus: TIdStatus; const AStatusText: String);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
appdir, sc_programu, change_dir: string;
implementation
{$R *.dfm}
procedure TForm1.FTPAfterUserLogin(ASender: TIdFTPServerThread);
begin
//ustawiamy katalog domowy podczas logowania
//jak np.: poniżej
ASender.HomeDir := '\';
ASender.CurrentDir := '\';
//użycie własnych zmiennych
appdir := sc_programu + ExtractFilePath(ParamStr(0));
//appdir :=ExtractFilePath(ParamStr(0));
end;
procedure TForm1.FTPUserLogin(ASender: TIdFTPServerThread;
const AUsername, APassword: String; var AAuthenticated: Boolean);
begin
//sprawdzenie użytkownika
AAuthenticated := ((AUsername = 'ktos') and (APassword = 'haslo'));
if AAuthenticated = true then
begin
//funkcje po rozpoznaniu użytkownika
end;
end;
procedure TForm1.FTPStoreFile(ASender: TIdFTPServerThread;
const AFileName: String; AAppend: Boolean; var VStream: TStream);
begin
//procedura odpowiedzialna za odbieranie pliku
if not Aappend then
begin
//odbieranie pliku - nowy plik
VStream := TFileStream.Create(AppDir + AFilename,fmCreate);
end;
if Aappend then
begin
//odbieranie pliku - nadpisywanie istniejącego
VStream := TFileStream.Create(AppDir + AFilename,fmOpenWrite);
end;
end;
procedure TForm1.FTPRetrieveFile(ASender: TIdFTPServerThread;
const AFileName: String; var VStream: TStream);
begin
//wysyłanie pliku
VStream := TFileStream.Create(AppDir + AFilename,fmOpenRead);
Application.ProcessMessages;
end;
procedure TForm1.FTPChangeDirectory(ASender: TIdFTPServerThread;
var VDirectory: String);
begin
//zmiana katalogu
Asender.CurrentDir := VDirectory;
//własna zmienna
change_dir := VDirectory;
end;
procedure TForm1.FTPListDirectory(ASender: TIdFTPServerThread;
const APath: String; ADirectoryListing: TIdFTPListItems);
var
LFTPItem :TIdFTPListItem;
SR : TSearchRec;
SRI : Integer;
begin
//przesłania zawartości katalogu do klienta
//ADirectoryListing.DirFormat := doUnix;
SRI := FindFirst(AppDir + change_dir + '*.*', faAnyFile - faHidden - faSysFile, SR);
While SRI = 0 do
begin
LFTPItem := ADirectoryListing.Add;
LFTPItem.FileName := SR.Name;
LFTPItem.Size := SR.Size;
LFTPItem.ModifiedDate := FileDateToDateTime(SR.Time);
Application.ProcessMessages;
if SR.Attr = faDirectory then
LFTPItem.ItemType := ditDirectory
else
LFTPItem.ItemType := ditFile;
SRI := FindNext(SR);
end;
FindClose(SR);
SetCurrentDir(AppDir + '..');
end;
procedure TForm1.FTPMakeDirectory(ASender: TIdFTPServerThread;
var VDirectory: String);
begin
//tworzenie katalogu
if not ForceDirectories(Appdir + VDirectory) then
begin
//można dodać komunikat błędu na serwerze
//najlepiej z zapisem do logu, a nie jak poniżej pokazuje przykład
//Raise Exception.Create('Błąd tworzenia katalogu');
end;
end;
procedure TForm1.FTPStatus(ASender: TObject;
const AStatus: TIdStatus; const AStatusText: String);
begin
ShowMessage(AStatusText);
end;
end.
Może wy mi coś poradzicie.
Używam Borland Delphi 7 Enterprise z Indy 9
Prosze pomużcie mi. :|
mój email endriuh@gmail.com i nr. GG 6859387
możecie mi napisać na e-mail lub na GG treść poprawionego kodu lub napisać co mam zrobić.