unit2.pas

绝对一流的压缩解压程序

 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
            filecount:=filecount+1;
            FORM2.Memo2.Lines.Add(sourcepath+sr.Name);
             end else
               begin

                 drecount:=drecount+1;
                 getallfiles(sourcepath+sr.Name);
                 END;
                 end;
                 until findnext(sr)<>0
                 end ;
                 findclose(sr);

                 end;
function SlashSep(const sPath, S: String): String;
begin
  if sPath='' then
  begin
    Result:='\';
    Exit;
  end;
  if (AnsiLastChar(sPath)^ <> '\') and (Copy(s,1,1)<>'\') then
    Result := sPath + '\' + S
  else if (AnsiLastChar(sPath)^ = '\') and (Copy(s,1,1)='\') then
    Result:=sPath+Trim(Copy(s,2,length(s)))
  else
    Result := sPath + S;
end;

procedure TForm2.FormCreate(Sender: TObject);
const
 time=4000;
 var
 s_time,e_time:integer;
begin
    filecount:=0;
    drecount:=0;
    s_time:=gettickcount;
    form5:=tform5.Create(application);
    form5.Show;
    form5.Update;
    e_time:=gettickcount;
     if e_time-s_time<time then
        sleep(time-(e_time-s_time));
        form5.Close;
        form5.Free;
end;



procedure TForm2.BitBtn4Click(Sender: TObject);
Var MemStr,MemStr1,MemStr2:TMemoryStream;
  FileName:String;
  FileNameSize,DataSize,rootpath_size:LongInt;
  i:Integer;
  rootpath:string;
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
  MemStr:=TMemoryStream.Create;
  MemStr1:=TMemoryStream.Create;
  MemStr2:=TMemoryStream.Create;
  memo2.Clear;
  rootpath:=getrootpath(dir);
  getallfiles(dir);
  try
    MemStr.Clear;
    MemStr1.Clear;
    MemStr2.Clear;
    with TCompressCtrl.Create(nil) do
    begin
      try
   if messagedlg('您要压缩的目录为'+dir+'确认吗？',mtconfirmation,[mbok]+[mbcancel],0)=idok then
        begin
          FileVer.Ver1:=1;
          FileVer.Ver2:=0;
          FileVer.Ver3:=0;
          FileVer.Ver4:=0;
          FileVer.VerStr:='WAR';
          rootpath_size:=length(rootpath);
          memstr2.WriteBuffer(rootpath_size,sizeof(longint));//写入根目录长度
          memstr2.WriteBuffer(pchar(rootpath)^,length(rootpath));//写入根目录
          MemStr2.WriteBuffer(FileVer,sizeof(TFileVer)); //写入文件版本号。
          For i:=0 to memo2.Lines.Count-1 do
          begin
            MemStr1.Clear;
            MemStr.Clear;
            memo1.Lines.Add('装入文件：'+memo2.Lines[i]);
            MemStr.LoadFromFile(memo2.Lines[i]);            //装入第i个文件。
            memo1.Lines.Add('正在压缩文件：'+memo2.Lines[i]);
            Backup(MemStr,MemStr1);                               //压缩第i个文件。

            FileName:=memo2.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('文件'+memo2.Lines[i]+'已经压缩完毕!');
          end;
          memo1.Lines.Add('要求压缩的目录'+dir+'已经压缩完毕!');
          FileNameSize:=-1;
          MemStr2.WriteBuffer(FileNameSize,sizeof(LongInt));      //写入一个-1。
          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;

procedure TForm2.BitBtn3Click(Sender: TObject);
Var MemStr,MemStr1,MemStr2:TMemoryStream;
  FileNameSize,DataSize,StreamSize,rootpath_size:LongInt;
  FileName:String;
  Dir2:String;
  bHasSelectDir:Boolean;
  rootpath:string;
  new_filepath:string;
  new_directory:string;
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
  MemStr:=TMemoryStream.Create;
  MemStr1:=TMemoryStream.Create;
  MemStr2:=TMemoryStream.Create;

  try
    MemStr.Clear;
    MemStr1.Clear;
    MemStr2.Clear;
    bHasSelectDir:=False;
    with TCompressCtrl.Create(nil) do
    begin
      try
        if OpenDialog2.Execute then
        begin
          memo1.Lines.Add('开始解压WAR文件：'+opendialog2.FileName);
           form1.Label1.Caption:='开始解压文件:';
           form1.Label2.Caption:=opendialog2.FileName;
           form1.ShowModal;
          MemStr1.LoadFromFile(OpenDialog2.FileName);
          MemStr1.Seek(0,0);
          StreamSize:=MemStr1.Size;
          memstr1.ReadBuffer(rootpath_size,sizeof(longint));
          SetString(rootpath, PChar(nil), rootpath_size);
          memstr1.ReadBuffer(Pchar(rootpath)^,rootpath_size);//读出根目录
          inc(StreamSize,-sizeof(longint));
          MemStr1.ReadBuffer(FileVer,sizeof(TFileVer)); //读出文件版本。
          inc(StreamSize,-sizeof(TFileVer));
          if
            (FileVer.Ver1=1)
            and (FileVer.Ver2=0)
            and (FileVer.Ver3=0)
            and (FileVer.Ver4=0)
            and (FileVer.VerStr='WAR') then
          begin
            FileNameSize:=0;
            While StreamSize>0 do
            begin
              MemStr1.ReadBuffer(FileNameSize,SizeOf(LongInt));    //读出一个文件名的长度。
              inc(StreamSize,-sizeof(LongInt));
              if StreamSize<=0 then
                Break;
              if FileNameSize=-1 then
                Break;
              SetString(FileName, PChar(nil), FileNameSize);       //设置字符串长度。
              MemStr1.ReadBuffer(PChar(FileName)^,FileNameSize);   //读出文件名。
              inc(StreamSize,-FileNameSize);
              if StreamSize<=0 then
                Break;
              MemStr1.ReadBuffer(DataSize,SizeOf(LongInt));        //读出数据长度。
              inc(StreamSize,-SizeOf(LongInt));
              if StreamSize<=0 then
                Break;
              if not bHasSelectDir then
              begin
                Dir2:=ExtractFilePath(FileName);
                if SelectDirectory(Dir2,[],0) then
                  bHasSelectDir:=True
                else
                  Break;
              end;
              MemStr2.Clear;
              MemStr2.CopyFrom(MemStr1,DataSize);                //读出压缩数据。
              Restore(MemStr2,MemStr);                           //解压缩数据。

      {开始处理文件的存储路径，以保存文件原目录的结构 }
       new_filepath:=getnew_filepath(filename,rootpath,dir2);
       new_directory:=getnew_directory(filename,rootpath,dir2,ExtractFileName(FileName));
        memo1.Lines.Add('解压原文件'+filename+'到新路径'+new_filepath+'完毕！');
          if not(directoryexists(new_directory)) then
               forcedirectories(new_directory);
              MemStr.SaveToFile(new_filepath); //保存。
              inc(StreamSize,-DataSize);
              if StreamSize<=0 then
                Break;
            end;
            form1.Label1.Caption:='文件解压到:';
            form1.Label2.Caption:=dir2;
            form1.ShowModal;
            memo1.Lines.Add('压缩文件'+opendialog2.FileName+'已经解压完毕！');

          end else
            Messagedlg('不是WAR类型文件或者是由文件压缩形成的压缩包!',mtinformation,[mbok],0);
        end;
      finally
        Free;
      end;
    end;
  finally
    MemStr.Free;
    MemStr1.Free;
    MemStr2.Free;
  end;

end;


procedure TForm2.BitBtn2Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
  if application.MessageBox('您确认要退出本压缩程序吗？','退出确认',mb_okcancel+mb_iconquestion+mb_systemmodal)=idok then
     close;
end;

procedure TForm2.BitBtn6Click(Sender: TObject);
Var MemStr,MemStr1,MemStr2:TMemoryStream;
  FileName:String;
  FileNameSize,DataSize:LongInt;
  i:Integer;
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
  MemStr:=TMemoryStream.Create;
  MemStr1:=TMemoryStream.Create;
  MemStr2:=TMemoryStream.Create;
  try
    MemStr.Clear;
    MemStr1.Clear;
    MemStr2.Clear;
    with TCompressCtrl.Create(nil) do
    begin
      try
        if OpenDialog1.Execute then
          if opendialog1.FileName<>''then
        begin
          FileVer.Ver1:=1;
          FileVer.Ver2:=0;
          FileVer.Ver3:=0;
          FileVer.Ver4:=0;
          FileVer.VerStr:='WAR';
          MemStr2.WriteBuffer(FileVer,sizeof(TFileVer)); //写入文件版本号。
          For i:=0 to OpenDialog1.Files.Count-1 do
          begin
            form1.Label1.Caption:='您要压缩的文件是:';
            form1.Label2.Caption:=opendialog1.Files[i];
            form1.ShowModal;
            MemStr1.Clear;
            MemStr.Clear;
            MemStr.LoadFromFile(OpenDialog1.Files[i]);            //装入第i个文件。
            Backup(MemStr,MemStr1);                               //压缩第i个文件。
            FileName:=OpenDialog1.Files[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个文件压缩后的数据。
          end;
          FileNameSize:=-1;
          MemStr2.WriteBuffer(FileNameSize,sizeof(LongInt));      //写入一个-1。

          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;

procedure TForm2.BitBtn5Click(Sender: TObject);
Var MemStr,MemStr1,MemStr2:TMemoryStream;
  FileNameSize,DataSize,StreamSize:LongInt;
  FileName:String;
  Dir3:String;
  bHasSelectDir:Boolean;
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
  MemStr:=TMemoryStream.Create;
  MemStr1:=TMemoryStream.Create;
  MemStr2:=TMemoryStream.Create;
  try
    MemStr.Clear;
    MemStr1.Clear;
    MemStr2.Clear;
    bHasSelectDir:=False;
    with TCompressCtrl.Create(nil) do
    begin
      try
        if OpenDialog2.Execute then
         if opendialog2.FileName<>''then
        begin
          MemStr1.LoadFromFile(OpenDialog2.FileName);
           form1.Label1.Caption:='开始解压文件:';
            form1.Label2.Caption:=OpenDialog2.FileName;
            form1.ShowModal;
          MemStr1.Seek(0,0);
          StreamSize:=MemStr1.Size;
          MemStr1.ReadBuffer(FileVer,sizeof(TFileVer));            //读出文件版本。
          inc(StreamSize,-sizeof(TFileVer));
          if
            (FileVer.Ver1=1)
            and (FileVer.Ver2=0)
            and (FileVer.Ver3=0)
            and (FileVer.Ver4=0)
            and (FileVer.VerStr='WAR') then
          begin
            FileNameSize:=0;
            While StreamSize>0 do
            begin
              MemStr1.ReadBuffer(FileNameSize,SizeOf(LongInt));    //读出一个文件名的长度。
              inc(StreamSize,-sizeof(LongInt));
              if StreamSize<=0 then
                Break;
              if FileNameSize=-1 then
                Break;
              SetString(FileName, PChar(nil), FileNameSize);       //设置字符串长度。
              MemStr1.ReadBuffer(PChar(FileName)^,FileNameSize);   //读出文件名。
              inc(StreamSize,-FileNameSize);
              if StreamSize<=0 then
                Break;