📄 main.pas
字号:
if AppDir[1]='\' then exit; //open on the LAN
//showmessage(mydir);
ini:=Tinifile.create(AppDir+'LanExplorer.ini');
ini.writeInteger('window position','top',top);
ini.writeInteger('window position','left',left);
ini.writeInteger('window position','width',width);
ini.writeInteger('window position','height',height);
ini.writeInteger('panel position','left_panel',LeftPanel.Width);
//ini.writeInteger('panel position','right_panel',RightPanel.Width);
ini.writeInteger('panel position','bottom_panel',BottomPanel.Height);
//nbtstat IP address
ini.WriteString('NBT_IP', 'IP1', ToolsForm.edtNbtIP1.Text);
ini.WriteString('NBT_IP', 'IP2', ToolsForm.edtNbtIP2.Text);
//TCP port scan address
ini.writeString('TCP_PORT_SCAN','IP1',ToolsForm.edtScanIP1.Text);
ini.writeString('TCP_PORT_SCAN','IP2',ToolsForm.edtScanIP2.Text);
//ping IP address
ini.writeString('PING','IP1',ToolsForm.edtPing1.Text);
ini.writeString('PING','IP2',ToolsForm.edtPing2.Text);
//Scan IP address
ini.writeString('SCAN','IP1',edtIP1.Text);
ini.writeString('SCAN','IP2',edtIP2.Text);
// Save History or not
if cbSaveHistory.Checked then ini.writeString('history','save','yes')
else ini.writeString('history','save','no');
if cbSaveOpt.Checked then ini.writeString('history','save_when_share','yes')
else ini.writeString('history','save_when_share','no');
ini.writeInteger('history','count', seHistoryCount.Value);
if ToolsForm.cbNbtDataLoad.Checked then ini.writeString('history','save_nbt','yes')
else ini.writeString('history','save_nbt','no');
// Search Type
if cbShare.Checked then ini.writeString('search_type','share','yes')
else ini.writeString('search_type','share','no');
if cbFtp.Checked then ini.writeString('search_type','ftp','yes')
else ini.writeString('search_type','ftp','no');
if cbHttp.Checked then ini.writeString('search_type','http','yes')
else ini.writeString('search_type','http','no');
ini.Free;
end;
procedure TMainForm.OpenHistory;
var
RootNode, TemNode, GroupNode: TTreeNode;
s: string;
f: TextFile;
MyItemPtr : PMyTreeItem;
begin
RootNode:=HistoryTree.Items[0];
GroupNode := RootNode; ///
if FileExists('History.txt') then
begin
AssignFile(f,'History.txt');
reset(f);
HistoryTree.Items.BeginUpdate; ///
while not eof(f) do
begin
Application.ProcessMessages;
readln(f,s);
s := trim(s);
if s = '' then continue;
if (s[1] <> '\')and(pos('ftp://', s)<>1) then //group
begin
GroupNode := HistoryTree.Items.AddChild(RootNode,s);
GroupNode.ImageIndex := 9;
GroupNode.SelectedIndex := 9;
end
else
begin
if (s[1] = '\') then
begin
New(MyItemPtr);
MyItemPtr^.group := GroupNode.Text;
MyItemPtr^.dirName := s;
TemNode:=HistoryTree.Items.AddChild(GroupNode, s);
TemNode.Data := MyItemPtr;
TemNode.ImageIndex := 7;
TemNode.SelectedIndex := 7;//12;
GroupNode.Expand(false);
end
else if (pos('ftp://', s) = 1) then
begin
TemNode:=HistoryTree.Items.AddChild(GroupNode, s);
TemNode.Data := nil;
TemNode.ImageIndex := 114;
TemNode.SelectedIndex := 114;
GroupNode.Expand(false);
end;
end;
end;
HistoryTree.Items.EndUpdate; ////
CloseFile(f);
RootNode.Expand(false);
end;
end;
procedure TMainForm.SaveHistory;
var
i, j : integer;
TempGroupNode : TTreeNode;
f : TextFile;
s : string;
StartIndex: integer;
begin
if (not cbSaveHistory.Checked) then exit;
if AppDir[1]<>'\' then //open on the LAN
begin
AssignFile(f, AppDir+'\History.txt');
rewrite(f);
if HistoryTree.Items[0].HasChildren then
begin
HistoryTree.Items.BeginUpdate; ///
for i:=1 to HistoryTree.Items[0].count do
begin
TempGroupNode:= HistoryTree.Items[0].Item[i-1]; //groups
writeln(f,TempGroupNode.text);
StartIndex := TempGroupNode.Count - seHistoryCount.Value;
if StartIndex <0 then StartIndex := 0;
for j := StartIndex to (TempGroupNode.Count-1)
do writeln(f, TempGroupNode.Item[j].Text); //host
end;
HistoryTree.Items.EndUpdate; ////
end;
CloseFile(f);
if GetFileSize(AppDir+'\History.txt') > (20*1024) then
begin
s := AppDir + 'History.txt文件太大，这可能影响程序启动和关闭的速度。是否重命名？';
if MessageBox(Handle, pchar(s),'LanExplorer' ,
MB_YESNO + MB_DEFBUTTON1 + MB_ICONQUESTION) = IDYES then
begin
SaveDlg.FileName := AppDir+'History'+'('+DateToStr(now)+').txt';
SaveDlg.InitialDir := AppDir;
if SaveDlg.Execute then
RenameFile(AppDir+'\History.txt', SaveDlg.FileName);
end;
end;
end;
end;
function CheckFavo(s:string):integer;
var
i, j: integer;
begin
j:=0;
for i:=1 to length(s) do if s[i]='\' then inc(j);
result := j;
if pos('ftp://', s) = 1 then result := -1
else if pos('http://', s) = 1 then result := -2;
end;
procedure TMainForm.OpenFavorite;
var
RootNode,TemNode : TTreeNode;
fg,fs : string;
f : TextFile;
MyItemPtr : PMyTreeItem;
begin
RootNode:=FavoTree.Items[0];
if fileexists('Favorite.txt') then
begin
assignfile(f, 'Favorite.txt');
reset(f);
FavoTree.Items.BeginUpdate;
while not eof(f) do
begin
Application.ProcessMessages;
readln(f, fg);
fg := trim(fg);
New(MyItemPtr);
MyItemPtr^.group := fg;
readln(f, fs);
fs := trim(fs);
MyItemPtr^.dirName := fs;
if (fg = '')or(fs = '') then
begin
Dispose(MyItemPtr);
continue;
end;
TemNode:=FavoTree.Items.AddChild(RootNode,fs);
TemNode.Data := MyItemPtr;
case CheckFavo(fs) of
0:begin
TemNode.ImageIndex := 5;
TemNode.SelectedIndex := 5;//16;
end;
2:begin
TemNode.ImageIndex := 7;
TemNode.SelectedIndex := 7;//12;
end;
-1:begin // FTP
TemNode.ImageIndex := 114;
TemNode.SelectedIndex := 114;
end;
-2:begin // HTTP
TemNode.ImageIndex := 123;
TemNode.SelectedIndex := 123;
end
else TemNode.ImageIndex := 0;
end; //end of case;
end;
FavoTree.Items.EndUpdate;
CloseFile(f);
try
FavoTree.Items[0].Expand(false);
except on ETreeViewError do FavoTree.Items.AddChildFirst(nil,'收藏');
end; //end of try
end;
end;
procedure TMainForm.SaveFavorite;
var
i : integer;
TempNode : TTreeNode;
f : TextFile;
begin
if AppDir[1]<>'\' then //open on the LAN
try
begin
//if (not FavoTree.Items[0].HasChildren)
// and(not FileExists(AppDir+'\Favorite.txt')) then exit;
AssignFile(f, AppDir+'\Favorite.txt');
ReWrite(f);
FavoTree.Items.BeginUpdate;
if FavoTree.Items[0].HasChildren then
begin
//tempNode:=nil; // just remove warning;
for i:=1 to FavoTree.Items[0].Count do
begin
TempNode := FavoTree.Items[0].Item[i-1];
if TempNode.ImageIndex < 113 then
begin
if TempNode.data <> nil then
try
writeln(f, trimright(pMyTreeItem(TempNode.data)^.group));
writeln(f, TempNode.text);
except {do nothing} end;
end
else
begin // FTP or http
writeln(f, TempNode.text);
writeln(f, TempNode.text);
end;
end;
//caption:=tempNode.text; // just remove warning;
end;
FavoTree.Items.EndUpdate;
CloseFile(f);
end
except {do nothing} end;
end;
{procedure TMainForm.BringFront;
begin
Application.BringToFront;
end;}
procedure TMainForm.MyListViewClick(Sender: TObject);
var
DirName,FileName,GroupName : string;
DirSearcher : TSearchDirThread;
Exe : TExecuteThread;
NewListItem,RunItem : TlistItem;
TemListView : TListView;
ListItemPtr : PListItem;
TabDataPtr : pTabData;
SubFtpDir : string;
OldRListItem : TListItem;
FtpSub : TFtpSubDirThread;
//FtpUsrName, FtpPassWord, FtpSvr, FtpDir: string;
col: TListColumn;
begin
RunItem:= (Sender as TListView).Selected;
if (RunItem=nil) then exit;
FileName:= RunItem.Caption;
DirName:=pTabData(ClientPageCtrl.ActivePage.Tag).MyDir;
GroupName:=pTabData(ClientPageCtrl.ActivePage.Tag).MyGroup;
if GroupName[length(GroupName)]=#0
then delete(GroupName,length(GroupName),1);
if pFileItem(RunItem.Data).fType = IsDir then //folder
begin
if (not IsFtp) then
begin
tabsheetx:=ttabsheet.Create(Self);
tabsheetx.PageControl := ClientPageCtrl;
DirName:=DirName+'\'+FileName;
tabsheetx.Caption := DirName;
tabsheetx.Repaint;
TemListView:=TListView.Create(tabsheetx);
with TemListView do
begin
Parent := tabsheetx;
Align := alclient;
Visible := true;
OnDblClick := MyListviewClick;
PopupMenu := pmListItem;
ViewStyle := vssmallicon;
SmallImages := imagelist1;
MultiSelect := true;
//FlatScrollBars := true;
DragMode := dmAutomatic;
//BorderStyle := bsNone;
OnMouseDown := BrowseListViewMouseDown; //##$$##
//-----------05.11.6----------
col := TemListView.Columns.Add;
col.Caption := '名称';
col.Width := 400;
col := TemListView.Columns.Add;
col.Caption := '大小';
col.Width := 100;
TemListView.ColumnClick := false;
//----------------------------
end;
ClientPageCtrl.ActivePageIndex :=tabsheetx.TabIndex;
//RightPageCtrl.ActivePageIndex:=1;
DirSearcher:=TSearchDirThread.create(true);
DirSearcher.mydir := DirName;
//DirSearcher.mygroup := groupname;
DirSearcher.myList := TemListView;
//DirSearcher.Rlist := ShareListView;
CurListView:=TemListView;
NewListItem:=ShareListview.Items.Insert(0);
NewListItem.Caption := extractfilename(DirSearcher.mydir);
New(ListItemPtr);
ListItemPtr.index := TabSheetX.TabIndex;
ListItemPtr.count := -1; //old history
NewListItem.data:= ListItemPtr;
NewListItem.SubItems.Add(DirName);
NewListItem.SubItems.Add(GroupName);
NewListItem.ImageIndex := 6;
//===================================================
if CurDirItem <> nil then
begin
PListItem(CurDirItem.Data)^.NextDirItem := NewListItem;
// uplink
PListItem(NewListItem.Data)^.UpDirItem := CurDirItem;
end;
ListItemPtr^.PrevDirItem := CurDirItem;
CurDirItem := NewListItem;
PListItem(CurDirItem.Data)^.NextDirItem := nil;
ToolBtnBack.Enabled := true;
ChangeBtnStatus;
//===================================================
new(TabDataPtr);
TabDataPtr.MyGroup := GroupName;
TabDataPtr.MyDir := DirName;
TabDataPtr.MyRListItem := NewListItem;
TabSheetX.Tag := integer(TabDataPtr);
AddCap(GroupName,DirName);
DirSearcher.RListItem := NewListItem;
DirSearcher.ClickType := InListView;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -