?? main.~pa
字號:
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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -