📄 unit2.pas
字号:
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,FileCtrl, WinSkinData, Buttons,strutils, ToolWin, ComCtrls,
Menus, ImgList, ShellCtrls, ExtCtrls,mmsystem,shellapi;
type
TFileVer=record
Ver1:Integer;
Ver2:Integer;
Ver3:Integer;
Ver4:Integer;
VerStr:String[4];
end;
TForm2 = class(TForm)
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
SaveDialog2: TSaveDialog;
OpenDialog2: TOpenDialog;
SkinData1: TSkinData;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N12: TMenuItem;
N14: TMenuItem;
N16: TMenuItem;
N17: TMenuItem;
N18: TMenuItem;
N19: TMenuItem;
N20: TMenuItem;
ToolBar1: TToolBar;
ImageList1: TImageList;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
BitBtn6: TBitBtn;
BitBtn7: TBitBtn;
BitBtn8: TBitBtn;
StatusBar1: TStatusBar;
ToolBar2: TToolBar;
ShellComboBox1: TShellComboBox;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
ShellTreeView1: TShellTreeView;
ShellListView1: TShellListView;
BitBtn9: TBitBtn;
ToolButton1: TToolButton;
BitBtn10: TBitBtn;
ToolButton2: TToolButton;
GroupBox3: TGroupBox;
Memo1: TMemo;
Memo2: TMemo;
pm1: TPopupMenu;
N21: TMenuItem;
N22: TMenuItem;
N23: TMenuItem;
N24: TMenuItem;
N25: TMenuItem;
N26: TMenuItem;
N27: TMenuItem;
N28: TMenuItem;
N29: TMenuItem;
N30: TMenuItem;
sd3: TSaveDialog;
Label1: TLabel;
BitBtn11: TBitBtn;
Memo3: TMemo;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
Label2: TLabel;
Label3: TLabel;
N31: TMenuItem;
fd1: TFontDialog;
t2: TTimer;
cd1: TColorDialog;
N32: TMenuItem;
N33: TMenuItem;
N34: TMenuItem;
pd1: TPrintDialog;
RichEdit1: TRichEdit;
N35: TMenuItem;
N36: TMenuItem;
N37: TMenuItem;
N38: TMenuItem;
N39: TMenuItem;
N40: TMenuItem;
N41: TMenuItem;
N42: TMenuItem;
N43: TMenuItem;
N44: TMenuItem;
ImageList2: TImageList;
N11: TMenuItem;
N45: TMenuItem;
N13: TMenuItem;
N46: TMenuItem;
N47: TMenuItem;
N15: TMenuItem;
N48: TMenuItem;
N50: TMenuItem;
N49: TMenuItem;
N51: TMenuItem;
N52: TMenuItem;
N53: TMenuItem;
BitBtn12: TBitBtn;
Label4: TLabel;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
procedure FormCreate(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure BitBtn10Click(Sender: TObject);
procedure BitBtn9Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N25Click(Sender: TObject);
procedure N23Click(Sender: TObject);
procedure N24Click(Sender: TObject);
procedure N27Click(Sender: TObject);
procedure N28Click(Sender: TObject);
procedure N30Click(Sender: TObject);
procedure ShellTreeView1Change(Sender: TObject; Node: TTreeNode);
procedure BitBtn7Click(Sender: TObject);
procedure t1Timer(Sender: TObject);
procedure ShellListView1Click(Sender: TObject);
procedure ShellTreeView1DblClick(Sender: TObject);
procedure BitBtn11Click(Sender: TObject);
procedure RadioButton1Click(Sender: TObject);
procedure RadioButton2Click(Sender: TObject);
procedure RadioButton3Click(Sender: TObject);
procedure ShellListView1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure ShellTreeView1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure N21Click(Sender: TObject);
procedure N31Click(Sender: TObject);
procedure t2Timer(Sender: TObject);
procedure N33Click(Sender: TObject);
procedure ShellListView1Change(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure N34Click(Sender: TObject);
procedure N37Click(Sender: TObject);
procedure N36Click(Sender: TObject);
procedure N38Click(Sender: TObject);
procedure N39Click(Sender: TObject);
procedure N17Click(Sender: TObject);
procedure N19Click(Sender: TObject);
procedure N41Click(Sender: TObject);
procedure N42Click(Sender: TObject);
procedure N43Click(Sender: TObject);
procedure N44Click(Sender: TObject);
procedure BitBtn6MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure BitBtn8Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure N13Click(Sender: TObject);
procedure N14Click(Sender: TObject);
procedure N15Click(Sender: TObject);
procedure N20Click(Sender: TObject);
procedure N45Click(Sender: TObject);
procedure N46Click(Sender: TObject);
procedure N50Click(Sender: TObject);
procedure N48Click(Sender: TObject);
procedure N51Click(Sender: TObject);
procedure BitBtn12Click(Sender: TObject);
private
FileVer:TFileVer;
{ Private declarations }
public
procedure getallfiles(sourcepath:string);
function getrootpath(fullpath:string):string;
function getnew_directory(fullpath,rootpath,new_dir,filename:string):string;
function getnew_filepath(fullpath,rootpath,new_dir:string):string;
procedure ys_files();
procedure files_information(rootpath:string);
end;
var
Form2: TForm2;
filecount,drecount:integer;
dir,file_dir,temp_dir:string;
flag:integer;//操作类型标示符
implementation
uses UnitCompr,unit1,unit3,unit4,unit5,unit6,unit7,unit8,unit9,unit10;
{$R *.DFM}
{$r wave.res}
procedure tform2.files_information(rootpath:string);
var
folderquery:tstringlist;
path:string;
r:integer;
f:tsearchrec;
all_files_size,filescount,folderscount:int64;//统计文件大小数目
begin
all_files_size:=0;
filescount:=0;
folderscount:=0;
if rootpath<>'' then
begin
if rootpath[length(rootpath)]<>'\' then
rootpath:=rootpath+'\';
folderquery:=tstringlist.Create;
try
folderquery.Add(rootpath);
while(folderquery.Count)>0 do
begin
path:=folderquery[0];
r:=findfirst(path+'*.*',faanyfile,f);
while(r=0) do
begin
if(f.Name<>'.')and(f.Name<>'..')then
begin
if((f.Attr and fadirectory)<>0)and(f.Name<>'.')and(f.Name<>'..')then
begin
folderquery.Add(path+f.Name+'\');
inc(folderscount,1);
end else
begin
inc(all_files_size,f.Size);
inc(filescount,1);
end;
end;
r:=findnext(f);
end;
folderquery.Delete(0);
end;
finally
folderquery.Free;
end;
statusbar1.Panels[1].Text:=inttostr(folderscount)+'个文件夹||'+inttostr(filescount)+'个文件||文件总大小:'+inttostr(all_files_size)+'字节';
end;
end;
procedure tform2.ys_files();
Var MemStr,MemStr1,MemStr2:TMemoryStream;
FileName:String;
FileNameSize,DataSize:LongInt;
i:Integer;
begin
MemStr:=TMemoryStream.Create;
MemStr1:=TMemoryStream.Create;
MemStr2:=TMemoryStream.Create;
try
MemStr.Clear;
MemStr1.Clear;
MemStr2.Clear;
with TCompressCtrl.Create(nil) do
begin
try
begin
form1.Label1.Caption:='你要压缩的文件是:';
form1.Label2.Caption:=memo3.Lines[0]+'等文件';
form1.ShowModal;
FileVer.Ver1:=1;
FileVer.Ver2:=0;
FileVer.Ver3:=0;
FileVer.Ver4:=0;
FileVer.VerStr:='WAR';
MemStr2.WriteBuffer(FileVer,sizeof(TFileVer)); //写入文件版本号。
For i:=1 to memo3.Lines.Count-1 do
begin
MemStr1.Clear;
MemStr.Clear;
memo1.Lines.Add('装入文件：'+memo3.Lines[i]);
MemStr.LoadFromFile(memo3.Lines[i]); //装入第i个文件。
memo1.Lines.Add('正在压缩文件：'+memo3.Lines[i]);
Backup(MemStr,MemStr1); //压缩第i个文件。
FileName:=memo3.Lines[i];
FileNameSize:=Length(FileName);
MemStr2.WriteBuffer(FileNameSize,sizeof(LongInt)); //写入第i个文件名长度。
MemStr2.WriteBuffer(PChar(FileName)^,FileNameSize); //写入第i个文件名。
DataSize:=MemStr1.Size;
MemStr2.WriteBuffer(DataSize,sizeof(LongInt)); //写入第i个文件压缩后的数据长度。
MemStr2.CopyFrom(MemStr1,MemStr1.Size); //写入第i个文件压缩后的数据。
memo1.Lines.Add('文件'+memo3.Lines[i]+'已经压缩完毕!');
end;
memo1.Lines.Add('所有文件已经压缩完毕!');
FileNameSize:=-1;
MemStr2.WriteBuffer(FileNameSize,sizeof(LongInt)); //写入一个-1。
memo3.Clear;
if SaveDialog1.Execute then
if savedialog1.FileName<>'' then
begin
MemStr2.SaveToFile(SaveDialog1.FileName);
form1.Label1.Caption:='文件保存到:';
form1.Label2.Caption:=SaveDialog1.FileName;
form1.ShowModal;
end;
end;
finally
Free;
end;
end;
finally
MemStr.Free;
MemStr1.Free;
MemStr2.Free;
end;
end;
function tform2.getnew_filepath(fullpath,rootpath,new_dir:string):string;//获取文件新的存取路径
var
file_newpath:string;
begin
file_newpath:=Ansireplacestr(fullpath,rootpath,new_dir);
result:=file_newpath;
end;
function TForm2.getnew_directory(fullpath,rootpath,new_dir,filename:string):string;//获取文件新的上层目录路径
var
temp_path:string;
temp2_path:string;
temp3_path:string;
begin
temp_path:=Ansireplacestr(fullpath,rootpath,new_dir);
temp2_path:=reversestring(temp_path);
delete(temp2_path,1,length(filename)+1);
temp3_path:=reversestring(temp2_path);
result:=temp3_path;
end;
function tform2.getrootpath(fullpath:string):string;//获得源文件的根目录路径
var
patharray:array[0..200]of char;
rootpath:string;
i,num,m:integer;
begin
m:=0;
strpcopy(patharray,fullpath);
num:=length(fullpath);
for i:=num-1 downto 0 do
if (patharray[i]='\')then
begin
m:=i;
break;
end;
rootpath:=copy(fullpath,0,m);
result:=rootpath;
end;
procedure Tform2.getallfiles(sourcepath:string); //遍历文件
var
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -