unit8.pas

绝对一流的压缩解压程序

unit Unit8;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons,filectrl,strutils, Menus, ExtCtrls, ComCtrls,mmsystem;

type
  TForm8 = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Memo1: TMemo;
    Memo2: TMemo;
    GroupBox4: TGroupBox;
    Label2: TLabel;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    Label3: TLabel;
    Edit2: TEdit;
    BitBtn2: TBitBtn;
    GroupBox5: TGroupBox;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    Label4: TLabel;
    Label5: TLabel;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
  private
    { Private declarations }
  public
   function get_rootpath(fullpath:string):string;
   procedure get_allfiles1(sourcepath,rootpath:string);
   procedure get_allfiles2(sourcepath,rootpath:string);
  end;

var
  Form8: TForm8;
  cp_dir1,cp_dir2:string;
implementation

{$R *.dfm}
function tform8.get_rootpath(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+1);
      result:=rootpath;

end;
procedure Tform8.get_allfiles1(sourcepath,rootpath:string); //遍历文件
var
 sr:tsearchrec;
begin
    sourcepath:=includetrailingbackslash(sourcepath);
      if findfirst(sourcepath+'\*.*',faanyfile,sr)=0 then
      begin
       repeat
       if(sr.Name<>'.')and(sr.Name<>'..')then
        begin
          if sr.Attr<>fadirectory then
           begin
            Memo1.Lines.Add('文件：'+ansireplacestr(sourcepath,rootpath,'')+sr.Name+'  大小:'+inttostr(sr.Size)+'  字节');
             end else
               begin
                 memo1.Lines.Add('是文件夹目录：'+ansireplacestr(sourcepath,rootpath,'')+sr.Name);
                 get_allfiles1(sourcepath+sr.Name,rootpath);
                 END;
                 end;
                 until findnext(sr)<>0
                 end ;
                 findclose(sr);

                 end;
procedure Tform8.get_allfiles2(sourcepath,rootpath:string); //遍历文件
var
 sr:tsearchrec;
begin
    sourcepath:=includetrailingbackslash(sourcepath);
      if findfirst(sourcepath+'\*.*',faanyfile,sr)=0 then
      begin
       repeat
       if(sr.Name<>'.')and(sr.Name<>'..')then
        begin
          if sr.Attr<>fadirectory then
           begin
            Memo2.Lines.Add('文件：'+ansireplacestr(sourcepath,rootpath,'')+sr.Name+'  大小:'+inttostr(sr.Size)+'  字节');
             end else
               begin
                 memo2.Lines.Add('是文件夹目录：'+ansireplacestr(sourcepath,rootpath,'')+sr.Name);
                 get_allfiles2(sourcepath+sr.Name,rootpath);
                 END;
                 end;
                 until findnext(sr)<>0
                 end ;
                 findclose(sr);

                 end;
procedure TForm8.BitBtn4Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
     close;
end;

procedure TForm8.BitBtn1Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
 if selectdirectory(cp_dir1,[sdallowcreate,sdperformcreate,sdprompt],0) then
          edit1.Text:=cp_dir1;
end;

procedure TForm8.BitBtn2Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
if selectdirectory(cp_dir2,[sdallowcreate,sdperformcreate,sdprompt],0) then
          edit2.Text:=cp_dir2;

end;

procedure TForm8.BitBtn3Click(Sender: TObject);
var
str1,str2:string;
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
   memo1.Clear;
   memo2.Clear;
 if (edit1.Text<>'')and(edit2.Text<>'')then
 begin
   str1:=get_rootpath(edit1.Text);
   str2:=get_rootpath(edit2.Text);
   end else
   begin
   messagedlg('请将比较的两个文件夹目录的路径填写完整!',mtwarning,[mbok],0);
   exit;
   end;

   get_allfiles1(edit1.Text,str1);
   get_allfiles2(edit2.Text,str2);
   if (memo1.Text<>'')and(memo2.Text<>'')then
   begin
      if memo1.Text=memo2.Text then
         messagedlg('比较结果：***两目录相等***',mtinformation,[mbok],0) else
                 messagedlg('比较结果：***两目录不相等***',mtinformation,[mbok],0);
                 end else
                  messagedlg('有错误无法比较文件夹目录!',mterror,[mbok],0);

end;

procedure TForm8.N1Click(Sender: TObject);
begin
    memo1.Clear;
    memo2.Clear;
    edit1.Clear;
    edit2.Clear;
end;

procedure TForm8.N3Click(Sender: TObject);
begin
    close;
end;

end.