Новости СЕТИ

К заголовку

Книги по Дельфи которые ВЫ ОБЯЗАНЫ ПРОЧИТАТЬ...

• Базы данных и приложения в дельфи 6 , спешите купить
• Delphi 6 : Наиболее полное руководство

Не столько учебник, сколько справочное пособие по наиболее используемым алгоритмам и командам...

• Дельфи 6: Учебный курс

Пожалуй лучший учебник по дельфи 6 на сегодняшний день, вам даже не надо знать дельфи, чтобы начать ...

• Дельфи 5: Руководство разработчика БД

 

DirectX. Графика в проектах Delphi (+CD - ROM)
Лучшее пособие для тех кто решил связаться с DirectX, по слухам на CD помимо примеров есть DirectxSDK7.0 от Microsoft...

Среда программирования Delphi 5-6. Справочное пособие
Книга полностью описывает среду программирования Delphi, которая включает в себя полный набор визуальных инструментов для быстрой и профессиональной разработки приложений для различных операционных систем, кроме того рассмотрены проблемы перехода между этими версиями дельфи.

Программирование в Delphi 6 (+ floppy дискета ) Чайникам рекомендуется!!!

Книга содержит методические и справочные материалы по новой версии системы визуального объектно-ориентированного программирования Delphi 6 и предшествующим версиям Delphi 5 и 4. Рассмотрены такие новые возможности Delphi, как кросс-платформенные приложения, технологии доступа к данным ADO, InterBase Express, dbExpress, компоненты — серверы СОМ, технологии распределенных приложений СОМ, CORBA, MIDAS, новая методика диспетчеризации действий...

Кодируем файл...

К заголовку

Скоро присвою себе название Research Lab , ей богу :)... Каждый день сижу и пытаюсь придумать что-нибудь необычное .
Вот эта штука может кодировать файлы, при том довольно сносно. Скорость конечно желает лучшего 300-400 кб в сек (в зависимости от винта и проца). Для избежания геммороя я ипользовал ассемблер и сделал инвертирование битов со сдвигом на 3. Кодированный файл , для верности можно еще и поделить на два, тогда информацию будет трудно разшифровать(при условии что половина файла будет бесполезна, а другая кодированна другим алгоритмом).

unit Unit2;

interface

uses windows,classes;
function code(FileName,outfile : string) : DWORD;
function decode(FileName,outfile : string) : DWORD;
implementation
uses unit1;

function code(FileName,outfile : string) : DWORD;
var
f,d1: file;
buf:dword;
ready:longint;
begin
// GetMem(buf,16384);
FileMode := 2;
assignfile(f,filename);
assignfile(d1,outfile);
reset(f,1) ;
rewrite(d1,1);
seek(f,0);
repeat
blockread(f,buf,1,ready);
asm
mov eax,buf
sub eax,3
not eax
mov buf,eax
end;
blockwrite(d1,buf,ready);
until ready=0;
closefile(d1);
closefile(f);

end;

/////////////
function decode(FileName,outfile : string) : DWORD;
var
f,d1: file;
buf:dword;
ready:longint;

begin

// GetMem(buf,16384);
FileMode := 2;
assignfile(f,filename);
assignfile(d1,outfile);
reset(f,1) ;
rewrite(d1,1);
seek(f,0);
repeat
blockread(f,buf,1,ready);
asm
mov eax,buf
not eax
add eax,3
mov buf,eax
end;
blockwrite(d1,buf,ready);
until ready=0;
closefile(d1);
closefile(f);

end;

end.

Собственно код получился небольшой и весьма оптимизированный.

FTP сервер

К заголовку

кусочек кода(98% , вырезан Aboutbox) программы SmallFTP server

unit Main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ImgList, ToolWin, Menus, Buttons, FtpSrv,FtpSrvC,
Spin,FileCtrl, ExtCtrls,Winsock;

type
TfrmMain = class(TForm)
StatusBar1: TStatusBar;
ImageList1: TImageList;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
ListView1: TListView;
RichEdit1: TRichEdit;
MainMenu1: TMainMenu;
PopupMenu1: TPopupMenu;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
FtpServer1: TFtpServer;
Label4: TLabel;
txtBanner: TEdit;
SpinEdit1: TSpinEdit;
Label5: TLabel;
ImageList2: TImageList;
File1: TMenuItem;
StartFTP1: TMenuItem;
StopFTP1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
Users1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
N2: TMenuItem;
Help2: TMenuItem;
BootUser2: TMenuItem;
ImageList3: TImageList;
ToolBar2: TToolBar;
ListView2: TListView;
ImageList4: TImageList;
ToolButton10: TToolButton;
ToolButton12: TToolButton;
ToolButton13: TToolButton;
ToolButton14: TToolButton;
Panel1: TPanel;
Label1: TLabel;
txtUser: TEdit;
Label2: TLabel;
txtPassword: TEdit;
Label3: TLabel;
txtRoot: TEdit;
BitBtn1: TBitBtn;
chkDelete: TCheckBox;
chkRename: TCheckBox;
chkDownload: TCheckBox;
chkUpload: TCheckBox;
Panel2: TPanel;
Timer1: TTimer;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
BitBtn4: TBitBtn;
SpinEdit2: TSpinEdit;
Label6: TLabel;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton5: TToolButton;
ToolButton4: TToolButton;
ToolBar3: TToolBar;
ImageList5: TImageList;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
SaveDialog1: TSaveDialog;
TheServer1: TMenuItem;
ActivityLog1: TMenuItem;
AllowedUsers1: TMenuItem;
ExtraOptions1: TMenuItem;
procedure ToolButton1Click(Sender: TObject);
procedure FtpServer1ChangeDirectory(Sender: TObject;
Client: TFtpCtrlSocket; Directory: TFtpString; var Allowed: Boolean);
procedure FtpServer1Authenticate(Sender: TObject;
Client: TFtpCtrlSocket; UserName, Password: TFtpString;
var Authenticated: Boolean);
procedure FtpServer1ValidateDele(Sender: TObject;
Client: TFtpCtrlSocket; var FilePath: TFtpString;
var Allowed: Boolean);
procedure FtpServer1ValidateGet(Sender: TObject;
Client: TFtpCtrlSocket; var FilePath: TFtpString;
var Allowed: Boolean);
procedure FtpServer1ValidatePut(Sender: TObject;
Client: TFtpCtrlSocket; var FilePath: TFtpString;
var Allowed: Boolean);
procedure FtpServer1ClientConnect(Sender: TObject;
Client: TFtpCtrlSocket; Error: Word);
procedure FtpServer1ClientDisconnect(Sender: TObject;
Client: TFtpCtrlSocket; Error: Word);
procedure FtpServer1ClientCommand(Sender: TObject;
Client: TFtpCtrlSocket; var Keyword, Params, Answer: TFtpString);
procedure FtpServer1Stop(Sender: TObject);
procedure FtpServer1Start(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ToolButton7Click(Sender: TObject);
function AddClient(sUser : String; sAction : String; sDir : String) : boolean;
procedure ModifyClient(sUser : String; sAction : String; sDir : String);
procedure RemoveClient(sUser : String);
function isClientThere(sUser : string): Boolean;
function isClient(sUser : String; sPass : String;Client: TFtpCtrlSocket): string;
procedure getClientpermissions(sUser : String);
procedure FormCreate(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure TabSheet3Exit(Sender: TObject);
procedure TabSheet3Enter(Sender: TObject);
function getClientRootDir(sUser : string): String;
procedure Timer1Timer(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure ToolButton10Click(Sender: TObject);
procedure ToolButton13Click(Sender: TObject);
procedure ToolButton14Click(Sender: TObject);
procedure LoadUserList;
procedure SaveUserList;
procedure ListView2SelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
procedure EditClient;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure ListView2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure bSaveUserList;
procedure ToolButton9Click(Sender: TObject);
procedure ToolButton6Click(Sender: TObject);
procedure TheServer1Click(Sender: TObject);
procedure ActivityLog1Click(Sender: TObject);
procedure AllowedUsers1Click(Sender: TObject);
procedure ExtraOptions1Click(Sender: TObject);
function IsAllowedTo(sUser : String; IAction : Integer) : Boolean;
procedure Help2Click(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmMain: TfrmMain;
bConnected: Boolean;
UserFile: String;
cliDir: String;
implementation

uses NewUser, Dir, About;

{$R *.DFM}
function GetLocalIP : string;
//
// Return computerґs IP if you are connected in a network
// Declare Winsock in the uses clause
//
type
TaPInAddr = array [0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe : PHostEnt;
pptr : PaPInAddr;
Buffer : array [0..63] of char;
I : Integer;
GInitData : TWSADATA;
begin
WSAStartup($101, GInitData);
Result := '';
GetHostName(Buffer, SizeOf(Buffer));
phe :=GetHostByName(buffer);
if phe = nil then
begin
Exit;
end;
pptr := PaPInAddr(Phe^.h_addr_list);
I := 0;
while pptr^[I] <> nil do
begin
result:=StrPas(inet_ntoa(pptr^[I]^));
Inc(I);
end;
WSACleanup;
end;
function bMakeBoolean(sStr : String): Boolean;
begin
if lowercase(sstr) = 'no' then
begin
bMakeBoolean := false;
end
else
begin
bMakeBoolean := true;
end;

end;

function bMakeString(bBool : Boolean): String;
begin
if bbool = false then
begin
bMakeString := 'No'
end
else
begin
bMakeString := 'Yes';
end;

end;

procedure Logit(sTXT : String);
begin
try
frmMain.RichEdit1.Lines.Insert(0,DateTimeToStr(Now) + ' - ' + stxt);
except
frmMain.RichEdit1.Lines.Clear;
frmMain.RichEdit1.Lines.Insert(0,DateTimeToStr(Now) + ' - ' + stxt);
end;

end;

function AppPath: String ;
//get the path of this file
begin
AppPath := ExtractFilePath(application.ExeName);
end;
function FileDelete(sFile :String):Boolean ;
begin
if FileExists(sFile) = True then
FileDelete := DeleteFile(sfile)
else
FileDelete := False;
end;
function DirDel(sPath : String):Boolean ;
begin
if DirectoryExists(sPath) = True then
DirDel := RemoveDir(sPath)
else
dirdel := false;
end;
function FileORDirDel(sPath : String; sFile : String): Boolean;
begin
if StrLen(pChar(sfile)) >0 then
//it is a file
FileORDirDel := filedelete(spath + sfile)
else
//it is a dir
FileORDirDel := dirdel(spath);
end;
function FileORDirRNTO(sPath : String; sFile : String): Boolean;
Var
iPos : Integer;
begin
ipos := pos('.',sFile);
if ipos > 0 then
//it is a file - handled by ftp
FileORDirRNTO := True
else
// it is a directory - manual rename c:\test\ / 222
if DirectoryExists(sPath) = True then
begin
FileORDirRNTO := MoveFile(pchar(spath),pchar(sfile));
end
else
begin
FileORDirRNTO := false;
end;

end;
function CheckStartDir(sDir : String):Boolean ;
begin
//make sure it is a dir
if sdir = '' then
CheckStartDir := false;

//it is a dir, check it
if sdir <> '' then
begin
CheckStartDir := DirectoryExists(sdir);
end;
end;

procedure FTPStart;
begin
frmmain.FtpServer1.Start;
Logit('FTP Started');
end;

procedure FTPStop;
begin
if bConnected = true then
begin
if MessageDlg('Warning stoping the FTP server will disconnect any clients!' + chr(10) + 'Are you sure you want to stop the FTP server?',mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
frmmain.FtpServer1.DisconnectAll;
frmmain.FtpServer1.Stop;
Logit('FTP Stopped');
end;
end;

end;

function GetLineEle(sTmp : String; Delimi1 : String; Delimi2 : String): String;
Var
Ipos :Integer;
Epos : Integer;
begin
try
ipos := pos(Delimi1,stmp);
if ipos = 0 then
begin
GetLineEle := '';
exit;
end;
epos := pos(Delimi2,stmp);
if epos = 0 then
begin
GetLineEle := '';
exit;
end;
ipos := ipos + Length(Delimi1);

GetLineEle := copy(stmp,ipos ,epos - ipos);
except
GetLineEle := '';
end;
end;

function QualifyDir(sDir : String):String ;
Var
Ipos :Integer;
TmpDir : String;
begin
ipos := StrLen(pchar(sdir));
tmpdir := copy(sdir,ipos,strlen(pchar(sdir)));
if tmpdir <> '\' then
QualifyDir := sdir + '\';
if tmpdir = '\' then
QualifyDir := sdir;
end;

procedure TfrmMain.ToolButton1Click(Sender: TObject);
begin
ftpstart;
end;

procedure TfrmMain.FtpServer1ChangeDirectory(Sender: TObject;
Client: TFtpCtrlSocket; Directory: TFtpString; var Allowed: Boolean);
begin
{ It the right place to check if a user has access to a given directory }
{ The example below disable C:\ access to non root user. }
//if (UpperCase(Client.UserName) <> 'ROOT') and
// (UpperCase(Client.Directory) = 'C:\') then
// Allowed := FALSE;

if length(Client.Directory) < length(client.HomeDir) then begin
Allowed := FALSE;
exit;
end;
//logit(client.username + ' CD ' +
Allowed := TRUE;
end;

procedure TfrmMain.FtpServer1Authenticate(Sender: TObject;
Client: TFtpCtrlSocket; UserName, Password: TFtpString;
var Authenticated: Boolean);
begin
//authorize client

if isClientThere(UserName) = false then
begin
clidir := isClient(username,password,client);

if clidir <> '' then
begin

//add the client to the list
Authenticated := true;
client.HomeDir := clidir;
//client.FileName :='';
end;
end
else
begin

//do not let them in multiple client error
Authenticated := false;
//client.Close;
end;
statusbar1.Panels[1].text := 'Number of Users: ' + inttostr(listview1.Items.count);
//Authenticated := True;
//client.HomeDir := 'd:\test\';
//client.FileName :='';
end;

procedure TfrmMain.FtpServer1ValidateDele(Sender: TObject;
Client: TFtpCtrlSocket; var FilePath: TFtpString; var Allowed: Boolean);
begin
{
if CheckBox5.Checked = FALSE then begin
allowed := FALSE;
end;
}
end;

procedure TfrmMain.FtpServer1ValidateGet(Sender: TObject;
Client: TFtpCtrlSocket; var FilePath: TFtpString; var Allowed: Boolean);
begin
{
if CheckBox5.Checked = FALSE then begin
allowed := FALSE;
end;
}
end;

procedure TfrmMain.FtpServer1ValidatePut(Sender: TObject;
Client: TFtpCtrlSocket; var FilePath: TFtpString; var Allowed: Boolean);
begin
{
if CheckBox5.Checked = FALSE then begin
allowed := FALSE;
end;
}
end;

procedure TfrmMain.FtpServer1ClientConnect(Sender: TObject;
Client: TFtpCtrlSocket; Error: Word);
begin
//do the connection here
Logit(client.UserName + ' - ' + client.DataSocket.Addr + ' Connected');
end;

procedure TfrmMain.FtpServer1ClientDisconnect(Sender: TObject;
Client: TFtpCtrlSocket; Error: Word);
begin
//do the disconnection here
RemoveClient(client.UserName);
statusbar1.Panels[1].text := 'Number of Users: ' + inttostr(listview1.Items.count);
Logit(client.UserName + ' - ' + client.DataSocket.Addr + ' Disconnected');
end;

procedure TfrmMain.FtpServer1ClientCommand(Sender: TObject;
Client: TFtpCtrlSocket; var Keyword, Params, Answer: TFtpString);
var
hGood : Boolean;
SFD1 : String;
SFD2 : String;
begin
hgood:=False;

{
We are looking for the following commands
PUT - upload
STOR - Upload
GET - download
RETR - download
DELE - delete
RNFR - rename from

}
ModifyClient(client.username,Keyword,client.directory);
Logit(client.UserName + ' - ' + client.DataSocket.Addr + ' ' + Keyword + ' ' + client.directory + params);
//DELE = delete
//if rename then begin
if (Keyword = 'PUT') or (Keyword = 'STOR') then
begin
if IsAllowedTo(client.username,2) = false then
begin
client.SendAnswer('501 - Not Allowed!');
exit;
end;
end;

if (Keyword = 'GET') or (Keyword = 'RETR') then
begin
if IsAllowedTo(client.username,3) = false then
begin
client.SendAnswer('501 - Not Allowed!');
exit;
end;
end;

//if rename then begin
//RNTO = rename from
if KeyWord ='RNFR' then
begin
if IsAllowedTo(client.username,4) = false then
begin
client.SendAnswer('501 - Not Allowed!');
exit;
end;
sfd1 := client.directory + params;

end;
//RNTO = rename to
if Keyword = 'RNTO' then
begin
if IsAllowedTo(client.username,4) = false then
begin
client.SendAnswer('501 - Not Allowed!');
exit;
end;
sfd2 := client.directory + params;
hgood := FileORDirRNTO(sfd1,sfd2);
sfd1 := '';
sfd2 := '';
end;

if Keyword = 'DELE' then
begin
if IsAllowedTo(client.username,5) = false then
begin
client.SendAnswer('501 - Not Allowed!');
exit;
end;
hgood := fileordirdel(client.Directory,params);
client.FileName :='';
client.Directory := '';
end;

end;

procedure TfrmMain.FtpServer1Stop(Sender: TObject);
begin
//ftp stop
toolbutton1.Enabled := true;
toolbutton2.Enabled := false;
startftp1.Enabled := true;
stopftp1.Enabled := false;
statusbar1.Panels[0].text := 'Ftp is OFF';
bConnected := false;
end;

procedure TfrmMain.FtpServer1Start(Sender: TObject);
begin
//ftp start
toolbutton1.Enabled := false;
toolbutton2.Enabled := true;
startftp1.Enabled := false;
stopftp1.Enabled := true;
statusbar1.Panels[0].text := 'Ftp is ON';
bConnected := true;
end;

procedure TfrmMain.ToolButton2Click(Sender: TObject);
begin
ftpstop;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ftpstop;
end;

procedure TfrmMain.ToolButton7Click(Sender: TObject);
begin
RichEdit1.Lines.Clear;
end;

function TfrmMain.AddClient(sUser : String; sAction : String; sDir : String) : boolean;
begin
//add a new client to the list

end;
procedure TfrmMain.ModifyClient(sUser : String; sAction : String; sDir : String);
Var
I : Integer;
ListItem: TListItem;
begin
//remove an existing client
for i := 0 to listview1.items.count -1 do
begin
if lowercase(suser) = lowercase(listview1.items[i].caption) then
begin
ListItem := listview1.Items[i];
listitem.SubItems[0] := saction;
listitem.SubItems[1] := sdir;
exit;
end;
end;
end;

procedure TfrmMain.RemoveClient(sUser : String);
Var
I : Integer;
begin
//remove an existing client
for i := 0 to listview1.items.count -1 do
begin
if lowercase(suser) = lowercase(listview1.items[i].caption) then
begin
listview1.Items.Delete(i);
exit;
end;
end;

end;
function TfrmMain.isClientThere(sUser : String): Boolean ;
Var
I : Integer;
bTMP : Boolean;
begin
// is the user there in our list
if ListView1.Items.Count = 0 then
begin
isClientThere := false;
exit;
end;
for I := 0 to ListView1.Items.Count -1 do
begin
//check the suser against the list item
if lowercase(suser) = lowercase(ListView1.Items[i].Caption) then
begin
isClientThere := true;
exit;
end;

isClientThere := false;

end;

end;
procedure TfrmMain.getClientpermissions(sUser : String);
begin
//get the client permissions

end;

function TfrmMain.isClient(sUser : String; sPass : String; Client: TFtpCtrlSocket): string ;
var
F: TextFile;
S: string;
zUser: String;
zPass: String;
zDir: String;
ListItem: TListItem;

begin
//is it a valid client
AssignFile(F, UserFile); { File selected in dialog box }
Reset(F);
while not EOF(F) do
begin
Readln(F, S); { Read the first line out of the file }
zUser := getlineele(s,'<user>','</user>');
zPass := getlineele(s,'<password>','</password>');
if (lowercase(zuser) = lowercase(suser)) and (lowercase(zpass) = lowercase(spass)) then
begin
//set the client permissions
zDir := getlineele(s,'<root>','</root>');
if directoryexists(zDir) = false then
begin
CloseFile(F);
isClient := '';
end;
CloseFile(F);
//add it to the list
listitem := ListView1.Items.Add;
listitem.Caption := suser; //username
listitem.SubItems.Add('Logged In'); //action
listitem.SubItems.Add(zdir); //location
listitem.SubItems.Add(getlineele(s,'<up>','</up>'));//upload
listitem.SubItems.Add(getlineele(s,'<down>','</down>'));//download
listitem.SubItems.Add(getlineele(s,'<rename>','</rename>'));//rename
listitem.SubItems.Add(getlineele(s,'<delete>','</delete>'));//delete
//return from function
isClient := zdir;
//CloseFile(F);
exit;
end;
end;
CloseFile(F);
isClient := '';
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
bConnected := false;
UserFile := apppath + 'users.txt';
LoadUserList;
end;

procedure TfrmMain.ToolButton4Click(Sender: TObject);
begin
if bConnected = true then
begin
if MessageDlg('Warning stoping the FTP server will disconnect any clients!' + chr(10) + 'Are you sure you want to stop the FTP server?',mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
frmmain.FtpServer1.DisconnectAll;
//clear the list
listview1.Items.Clear;
Logit('All Users Booted');
end;
end;
end;

procedure TfrmMain.TabSheet3Exit(Sender: TObject);
begin
listview1.Items := listview2.Items;
listview2.Items.Clear;
end;

procedure TfrmMain.TabSheet3Enter(Sender: TObject);
begin
listview2.Items := listview1.Items;
end;

function TfrmMain.getClientRootDir(sUser : String): String;
Var
I : Integer;
ListItem: TListItem;
begin
for i := 0 to listview1.Items.count - 1 do
begin
ListItem := listview1.Items[i];
if lowercase(suser) = lowercase(ListItem.Caption) then
begin
getClientRootDir := listitem.SubItems[1];
exit;
end;
end;
getClientRootDir := '';

end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
Panel2.Caption := 'Local IP Addess: ' + GetLocalIP;
statusbar1.Panels[1].text := 'Number of Users: ' + inttostr(listview1.Items.count);
end;

procedure TfrmMain.BitBtn2Click(Sender: TObject);
begin
if bConnected = true then
begin
showmessage('Please Stop FTP Server before applying these options.');
exit;
end;
FtpServer1.Banner := txtbanner.Text;
FtpServer1.MaxClients := SpinEdit1.Value;
FtpServer1.Port := inttostr(SpinEdit2.Value);
end;

procedure TfrmMain.BitBtn3Click(Sender: TObject);
begin
if bConnected = true then
begin
showmessage('Please Stop FTP Server before applying these options.');
exit;
end;
txtbanner.Text := '220 Personal FTP Ready';
SpinEdit1.Value := 200;
SpinEdit2.Value := 21;
FtpServer1.Banner := txtbanner.Text;
FtpServer1.MaxClients := SpinEdit1.Value;
FtpServer1.Port := inttostr(SpinEdit2.Value);
end;

procedure TfrmMain.ToolButton10Click(Sender: TObject);
begin
//dump the listview2 contents to the user file
bSaveUserList;
//TO DO - update all logged in clients
//Maybe I will do this in the next version?

end;

procedure TfrmMain.ToolButton13Click(Sender: TObject);
var
ListItem: TListItem;
I : Integer;
bTMP : Boolean;
begin
//add a user
frmnewuser.showmodal;
if frmnewuser.Execute = true then
begin
//make sure we are not adding a duplicate
for i := 0 to listview1.Items.Count -1 do
begin
ListItem := listview2.Items[i];
if lowercase(listitem.caption) = lowercase(frmnewuser.txtuser.text) then
begin
//duplicate found
showmessage('User Already Exists');
exit;
end;

end;
//duplicate not found, add new user
ListItem := listview2.Items.Add;
ListItem.Caption := frmnewuser.txtuser.text;
listitem.SubItems.Add(frmnewuser.txtPassword.text); //password
listitem.SubItems.Add(frmnewuser.DirectoryListBox1.Directory); //root dir
listitem.SubItems.Add(bmakestring(frmnewuser.chkUpload.checked));//upload
listitem.SubItems.Add(bmakestring(frmnewuser.chkdownload.checked));//download
listitem.SubItems.Add(bmakestring(frmnewuser.chkrename.checked));//rename
listitem.SubItems.Add(bmakestring(frmnewuser.chkdelete.checked));//delete
//reset the wizard
frmnewuser.txtUser.Text := 'Anonymous';
frmnewuser.txtPassword.Text := 'Guest';
frmnewuser.chkUpload.checked := false;
frmnewuser.chkdownload.checked := false;
frmnewuser.chkrename.checked := false;
frmnewuser.chkdelete.checked := false;
end;

end;

procedure TfrmMain.ToolButton14Click(Sender: TObject);
begin
//remove selected user
if listview2.SelCount > 0 then
begin
listview2.Items.Delete(listview2.Selected.Index);
end;
end;

procedure TfrmMain.LoadUserList();
var
F: TextFile;
S: string;
zTMP: String;
ListItem: TListItem;
begin
//load the user list into listview2
AssignFile(F, UserFile); { File selected in dialog box }
Reset(F);
//read the file line by line
while not EOF(F) do
begin
Readln(F, S); { Read the first line out of the file }
//add it to the list
listitem := ListView2.Items.Add;
listitem.Caption := getlineele(s,'<user>','</user>'); //username
listitem.SubItems.Add(getlineele(s,'<password>','</password>')); //password
listitem.SubItems.Add(getlineele(s,'<root>','</root>')); //root dir
listitem.SubItems.Add(getlineele(s,'<up>','</up>'));//upload
listitem.SubItems.Add(getlineele(s,'<down>','</down>'));//download
listitem.SubItems.Add(getlineele(s,'<rename>','</rename>'));//rename
listitem.SubItems.Add(getlineele(s,'<delete>','</delete>'));//delete
end;
CloseFile(F);
end;
procedure TfrmMain.SaveUserList();
begin
//save the user list from listview2

end;
procedure TfrmMain.ListView2SelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
begin
txtuser.Text := item.Caption;

txtpassword.text := item.SubItems.Strings[0];
txtroot.text := item.SubItems.Strings[1];
chkupload.checked := bMakeBoolean(item.SubItems.Strings[2]); //upload
chkdownload.checked := bMakeBoolean(item.SubItems.Strings[3]);//download
chkrename.checked := bMakeBoolean(item.SubItems.Strings[4]);//rename
chkdelete.checked := bMakeBoolean(item.SubItems.Strings[5]);//delete

end;
procedure TfrmMain.EditClient();
Var
ListItem: TListItem;
begin
//exit if none in list
if listview2.items.count = 0 then exit;
//exit if none selected
if listview2.SelCount = 0 then exit;
//set our listview item
ListItem := listview2.Selected;
if txtUser.text = '' then txtuser.text := 'Anonymous';
if txtpassword.text = '' then txtpassword.text := 'Guest';

listitem.Caption := txtuser.text;
listitem.SubItems[0] := txtpassword.text; //password
listitem.SubItems[1] := txtroot.text; //root dir
listitem.SubItems[2] := bMakeString(chkupload.checked); //upload
listitem.SubItems[3] := bMakeString(chkdownload.checked);//download
listitem.SubItems[4] := bMakeString(chkrename.checked); //rename
listitem.SubItems[5] := bMakeString(chkdelete.checked); //delete
end;

procedure TfrmMain.BitBtn1Click(Sender: TObject);
begin
//show the browse for dir dialog;
if directoryexists(txtroot.text) = true then
frmdir.DirectoryListBox1.Directory := txtroot.text;

frmdir.showmodal;
if frmdir.Execute = true then
txtRoot.Text := frmdir.DirectoryListBox1.Directory;

end;

procedure TfrmMain.BitBtn4Click(Sender: TObject);
begin
editclient;
end;

procedure TfrmMain.ListView2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if listview2.SelCount = 0 then
begin
txtuser.Text := '';
txtpassword.text := '';
txtroot.Text := '';
chkupload.Checked := false;
chkdownload.Checked := false;
chkrename.checked := false;
chkdelete.checked := false;
end;
end;
procedure TfrmMain.bSaveUserList();
var
F: TextFile;
S: string;
ListItem: TListItem;
I : Integer;
begin
//save the user list from listview2
AssignFile(F, UserFile); { File selected in dialog box }
Rewrite(F);
for i := 0 to listview2.Items.Count -1 do
begin
ListItem := listview2.Items[i];
s := '<user>' + listitem.Caption + '</user>';
s := s + '<password>' + listitem.SubItems.Strings[0] + '</password>';
s := s + '<root>' + listitem.SubItems.Strings[1] + '</root>';
s := s + '<up>' + listitem.SubItems.Strings[2] + '</up>';
s := s + '<down>' + listitem.SubItems.Strings[3] + '</down>';
s := s + '<rename>' + listitem.SubItems.Strings[4] + '</rename>';
s := s + '<delete>' + listitem.SubItems.Strings[5] + '</delete>';
Writeln(F, s);
end;

CloseFile(F);
end;

procedure TfrmMain.ToolButton9Click(Sender: TObject);
begin
//reload the list
listview2.Items.Clear;
LoadUserList;
if listview2.SelCount = 0 then
begin
txtuser.Text := '';
txtpassword.text := '';
txtroot.Text := '';
chkupload.Checked := false;
chkdownload.Checked := false;
chkrename.checked := false;
chkdelete.checked := false;
end;
end;

procedure TfrmMain.ToolButton6Click(Sender: TObject);
begin
//save the log file as...
if savedialog1.Execute = true then
begin
RichEdit1.Lines.SaveToFile(savedialog1.filename);
end;

end;

procedure TfrmMain.TheServer1Click(Sender: TObject);
begin
PageControl1.ActivePage := tabsheet1;
end;

procedure TfrmMain.ActivityLog1Click(Sender: TObject);
begin
PageControl1.ActivePage := tabsheet2;
end;

procedure TfrmMain.AllowedUsers1Click(Sender: TObject);
begin
PageControl1.ActivePage := tabsheet3;
end;

procedure TfrmMain.ExtraOptions1Click(Sender: TObject);
begin
PageControl1.ActivePage := tabsheet4;
end;
function TfrmMain.IsAllowedTo(sUser : String; IAction : Integer): Boolean;
Var
ListItem: TListItem;
I : Integer;
begin
//see if the client is allowed to do something
for i := 0 to listview1.Items.Count -1 do
begin
listitem := listview1.items[i];
//see if it is the client
if lowercase(suser) = lowercase(listitem.caption) then
begin
IsAllowedTo := bMakeBoolean(listitem.SubItems.Strings[IAction]);
exit;
end;
end;
//not found - return false just to be safe
IsAllowedTo := false;
end;

procedure TfrmMain.Help2Click(Sender: TObject);
begin
showmessage('Sorry no Help File');
end;

procedure TfrmMain.About1Click(Sender: TObject);
begin
frmabout.showmodal;
end;

procedure TfrmMain.Exit1Click(Sender: TObject);
begin
close;
end;

end.