unit2.pas

绝对一流的压缩解压程序

              MemStr1.ReadBuffer(DataSize,SizeOf(LongInt));        //读出数据长度。
              inc(StreamSize,-SizeOf(LongInt));
              if StreamSize<=0 then
                Break;
              if not bHasSelectDir then
              begin
                Dir3:=ExtractFilePath(FileName);
                if SelectDirectory(Dir3,[],0) then
                  bHasSelectDir:=True
                else
                  Break;
              end;
              MemStr2.Clear;
              MemStr2.CopyFrom(MemStr1,DataSize);                //读出压缩数据。
              Restore(MemStr2,MemStr);                           //解压缩数据。
              MemStr.SaveToFile(SlashSep(Dir3,ExtractFileName(FileName)));           //保存。
              inc(StreamSize,-DataSize);
              if StreamSize<=0 then
                Break;
            end;
            form1.Label1.Caption:='文件解压到:';
            form1.Label2.Caption:=dir3;
            form1.ShowModal;
          end else
            Messagedlg('不是WAR类型文件或者是由文件夹压缩形成的压缩包!',mtinformation,[mbok],0);
        end;
      finally
        Free;
      end;
    end;
  finally
    MemStr.Free;
    MemStr1.Free;
    MemStr2.Free;
  end;
end;

procedure TForm2.BitBtn10Click(Sender: TObject);
Var MemStr,MemStr1,MemStr2:TMemoryStream;
  FileNameSize,DataSize,StreamSize:LongInt;
  FileName:String;
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
  Memo1.Clear;
  MemStr:=TMemoryStream.Create;
  MemStr1:=TMemoryStream.Create;
  MemStr2:=TMemoryStream.Create;
  try
    MemStr.Clear;
    MemStr1.Clear;
    MemStr2.Clear;
    with TCompressCtrl.Create(nil) do
    begin
      try
        if OpenDialog2.Execute then
        begin
          MemStr1.LoadFromFile(OpenDialog2.FileName);
          MemStr1.Seek(0,0);
          StreamSize:=MemStr1.Size;
          MemStr1.ReadBuffer(FileVer,sizeof(TFileVer));            //读出文件版本。
          inc(StreamSize,-sizeof(TFileVer));
          memo1.Lines.Add('测试结果如下：');
          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);   //读出文件名。

              Memo1.Lines.Add(FileName);
              inc(StreamSize,-FileNameSize);
              if StreamSize<=0 then
                Break;
              MemStr1.ReadBuffer(DataSize,SizeOf(LongInt));        //读出数据长度。
              inc(StreamSize,-SizeOf(LongInt));
              if StreamSize<=0 then
                Break;
              MemStr1.Seek(DataSize,soFromCurrent);
              inc(StreamSize,-DataSize);
              if StreamSize<=0 then
                Break;
            end;
          end else
           Messagedlg('不是WAR类型文件或者是由文件夹压缩形成的压缩包!',mtinformation,[mbok],0);
        end;
      finally
        Free;
      end;
    end;
  finally
    MemStr.Free;
    MemStr1.Free;
    MemStr2.Free;
  end;
end;


procedure TForm2.BitBtn9Click(Sender: TObject);
Var MemStr,MemStr1,MemStr2:TMemoryStream;
  FileNameSize,DataSize,StreamSize:LongInt;
  FileName:String;
  rootpath_size:integer;
  rootpath:string;
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
  Memo1.Clear;
  MemStr:=TMemoryStream.Create;
  MemStr1:=TMemoryStream.Create;
  MemStr2:=TMemoryStream.Create;
  try
    MemStr.Clear;
    MemStr1.Clear;
    MemStr2.Clear;
    with TCompressCtrl.Create(nil) do
    begin
      try
        if OpenDialog2.Execute then
        begin
          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;
            memo1.Lines.Add('测试结果如下：');
            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);   //读出文件名。
              Memo1.Lines.Add(FileName);
              inc(StreamSize,-FileNameSize);
              if StreamSize<=0 then
                Break;
              MemStr1.ReadBuffer(DataSize,SizeOf(LongInt));        //读出数据长度。
              inc(StreamSize,-SizeOf(LongInt));
              if StreamSize<=0 then
                Break;
              MemStr1.Seek(DataSize,soFromCurrent);
              inc(StreamSize,-DataSize);
              if StreamSize<=0 then
                Break;
            end;
          end else
            Messagedlg('不是WAR类型文件或者是由文件压缩形成的压缩包!',mtinformation,[mbok],0);
        end;
      finally
        Free;
      end;
    end;
  finally
    MemStr.Free;
    MemStr1.Free;
    MemStr2.Free;
  end;
end;

procedure TForm2.N8Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
  bitbtn2.Click;
end;

procedure TForm2.N3Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
 shelllistview1.ViewStyle:=vsicon;
end;

procedure TForm2.N4Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
shelllistview1.ViewStyle:=vssmallicon;
end;

procedure TForm2.N5Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
    shelllistview1.ViewStyle:=vslist;
end;

procedure TForm2.N6Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
  shelllistview1.ViewStyle:=vsreport;
end;

procedure TForm2.N25Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
 if memo1.ReadOnly=true then
 begin
    memo1.ReadOnly:=false;
    memo1.CutToClipboard ;
    end;
    memo1.ReadOnly:=true;

end;

procedure TForm2.N23Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
if memo1.ReadOnly=true then
 begin
     memo1.ReadOnly:=false;
     memo1.CopyToClipboard;
     end;
     memo1.ReadOnly:=true;
end;

procedure TForm2.N24Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
  if memo1.ReadOnly=true then
  begin
     memo1.ReadOnly:=false;
     memo1.PasteFromClipboard;
     end;
     memo1.ReadOnly:=true;
end;

procedure TForm2.N27Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
     memo1.SelectAll;
end;

procedure TForm2.N28Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
     memo1.Clear;
end;

procedure TForm2.N30Click(Sender: TObject);
begin
 playsound(pchar('down1'),hinstance,snd_async or snd_resource);
     if sd3.Execute then
        memo1.Lines.SaveToFile(sd3.FileName)
        else
        messagedlg('无法保存文件！',mterror,[mbok],0);
end;

procedure TForm2.ShellTreeView1Change(Sender: TObject; Node: TTreeNode);
begin
if shelltreeview1.SelectedFolder<>nil then
 begin
   statusbar1.Panels[0].text:='已选择：'+shelltreeview1.Path;
   if n46.Checked=true then
   begin
    statusbar1.Panels[1].Text:='需要时间来统计文件夹和文件数目，请您稍后......';
   files_information(shelltreeview1.Path);
   end else
    statusbar1.Panels[1].text:='欢迎您使用本压缩程序－ZJWAR***制作***：ZJ';
end;
end;
procedure TForm2.BitBtn7Click(Sender: TObject);
begin
   playsound(pchar('down1'),hinstance,snd_async or snd_resource);
     n51.Click;
end;

procedure TForm2.t1Timer(Sender: TObject);
begin
   form1.Close;
end;

procedure TForm2.ShellListView1Click(Sender: TObject);
var
i:integer;
flg:boolean;
begin
playsound(pchar('menu1'),hinstance,snd_async or snd_resource);
flg:=true;
if shelllistview1.SelectedFolder<>nil then
  begin
   if shelllistview1.SelectedFolder.IsFolder then
   begin
   temp_dir:=shelllistview1.selectedfolder.PathName;
   memo1.Lines.Add('您选择的是文件夹：'+temp_dir);
   end else
   begin
   file_dir:=shelllistview1.selectedfolder.PathName;
   memo1.Lines.Add('您选择的是文件：'+file_dir);
    end;
    end;
case flag of
1:
begin
   shelllistview1.MultiSelect:=false;
   if shelllistview1.SelectedFolder<>nil then
  begin
   if shelllistview1.SelectedFolder.IsFolder then
   begin
   dir:=shelllistview1.selectedfolder.PathName;
   end else
   exit;
    end;
    end;
2:
 begin
 shelllistview1.MultiSelect:=false;
 if shelllistview1.SelectedFolder<>nil then
  begin
   if shelllistview1.SelectedFolder.IsFolder then
   begin
     exit;
   end else
   begin
   file_dir:=shelllistview1.selectedfolder.PathName;
    end;
    end;
 end;
3:
 BEGIN
 shelllistview1.MultiSelect:=true;
 if shelllistview1.SelectedFolder<>nil then
  begin
   if shelllistview1.SelectedFolder.IsFolder then
   begin
   exit;
   end else
   begin
  for i:=0 to memo3.Lines.Count-1 do
   begin
   if memo3.Lines[i]=shelllistview1.selectedfolder.PathName then
   begin
   flg:=false;
    exit;
    end;
    end;
   if flg=true then
      memo3.Lines.Add(shelllistview1.selectedfolder.PathName);
    end;
    end;
 END;
 end;