unit2.pas

绝对一流的压缩解压程序

end;

procedure TForm2.ShellTreeView1DblClick(Sender: TObject);
begin
 playsound(pchar('on1'),hinstance,snd_async or snd_resource);
         dir:=shelltreeview1.Path;
 if messagedlg('您要压缩的目录为'+dir+'确认吗？',mtconfirmation,[mbok]+[mbcancel],0)=idok then
         begin
         form1.Label1.Caption:='你要压缩的文件目录是:';
         form1.Label2.Caption:=dir;
         form1.ShowModal;
         bitbtn4.Click;
         end;
end;

procedure TForm2.BitBtn11Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
 shelllistview1.Back;
end;

procedure TForm2.RadioButton1Click(Sender: TObject);
begin
    flag:=1;
end;

procedure TForm2.RadioButton2Click(Sender: TObject);
begin
         flag:=2;
end;

procedure TForm2.RadioButton3Click(Sender: TObject);
begin
  messagedlg('现在您每点击一个文件系统就会自动将其添加到压缩目录压缩，不想压缩的文件请勿点击!',mtinformation,[mbok],0);
     flag:=3;
end;

procedure TForm2.ShellListView1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
  Var MemStr,MemStr1,MemStr2:TMemoryStream;
  FileName:String;
  FileNameSize,DataSize:LongInt;
  i:Integer;
begin
    if key=119 then
    begin
    playsound(pchar('down1'),hinstance,snd_async or snd_resource);
     case flag of
       1: begin
          if messagedlg('您要压缩的目录为'+dir+'确认吗？',mtconfirmation,[mbok]+[mbcancel],0)=idok then
          begin
            form1.Label1.Caption:='你要压缩的文件目录是:';
            form1.Label2.Caption:=dir;
            form1.ShowModal;
            bitbtn4.Click;
            end;
           end;
       2:begin
         MemStr:=TMemoryStream.Create;
          MemStr1:=TMemoryStream.Create;
            MemStr2:=TMemoryStream.Create;
  try
    MemStr.Clear;
    MemStr1.Clear;
    MemStr2.Clear;
    with TCompressCtrl.Create(nil) do
    begin
      try
       if messagedlg('您要压缩'+file_dir+'确认吗？',mtconfirmation,[mbok]+[mbcancel],0)=idok then
        begin
          FileVer.Ver1:=1;
          FileVer.Ver2:=0;
          FileVer.Ver3:=0;
          FileVer.Ver4:=0;
          FileVer.VerStr:='WAR';
          MemStr2.WriteBuffer(FileVer,sizeof(TFileVer)); //写入文件版本号。
            MemStr1.Clear;
            MemStr.Clear;
            memo1.Lines.Add('装入文件'+file_dir);
            MemStr.LoadFromFile(file_dir);            //装入文件。

            form1.Label1.Caption:='你要压缩的文件是:';
            form1.Label2.Caption:=file_dir;
            form1.ShowModal;
            memo1.Lines.Add('正在压缩'+file_dir);
            Backup(MemStr,MemStr1);                               //压缩文件。
            FileName:=file_dir;
            FileNameSize:=Length(FileName);
            MemStr2.WriteBuffer(FileNameSize,sizeof(LongInt));    //写入文件名长度。
            MemStr2.WriteBuffer(PChar(FileName)^,FileNameSize);   //写入文件名。
            DataSize:=MemStr1.Size;
            MemStr2.WriteBuffer(DataSize,sizeof(LongInt));        //写入压缩后的数据长度。
            MemStr2.CopyFrom(MemStr1,MemStr1.Size);               //写入文件压缩后的数据。
            FileNameSize:=-1;
            MemStr2.WriteBuffer(FileNameSize,sizeof(LongInt));      //写入一个-1。
            memo1.Lines.Add('文件'+filename+'已经压缩完毕!');
            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;
       3:begin
       if memo3.Lines.Count>0 then
          ys_files else
              showmessage('未选择文件 请您选择后再按键压缩!');
          radiobutton1.Checked:=true;
         end;
    end;
   end;
end;

procedure TForm2.ShellTreeView1Click(Sender: TObject);
begin
playsound(pchar('menu1'),hinstance,snd_async or snd_resource);
   dir:=shelltreeview1.Path;
   memo1.Lines.Add('您选择的当前目录是：'+dir);
end;

procedure TForm2.FormShow(Sender: TObject);
begin
 dir:='d:\';
 memo1.Lines.Add('当前为初始目录：'+dir);
 bitbtn6.SetFocus;
 form1.Label1.Caption:='欢迎您使用本压缩程序***ZJWAR***||Make By ZJ||!';
 form1.Label2.Caption:='北京邮电大学计算机科学与技术学院02级***ZJ***';
 form1.ShowModal;
end;

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

procedure TForm2.N31Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
     if fd1.Execute then
       memo1.Font:=fd1.Font;
end;

procedure TForm2.t2Timer(Sender: TObject);
begin
    statusbar1.Panels[2].Text:='当前时间日期：'+datetimetostr(now);
end;

procedure TForm2.N33Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
     if cd1.Execute then
        memo1.Color:=cd1.Color;
end;

procedure TForm2.ShellListView1Change(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
      if shelllistview1.SelectedFolder<>nil then
        begin
          statusbar1.Panels[0].text:='已选择：'+shelllistview1.Selectedfolder.PathName;
         IF n46.Checked=true then
         begin
          statusbar1.Panels[1].Text:='需要时间来统计文件夹和文件数目，请您稍后......';
          files_information(shelllistview1.Selectedfolder.PathName);
          end else
          statusbar1.Panels[1].text:='希望您能指出程序中的不足，谢谢!QQ:89619780';
          end;
end;

procedure TForm2.N34Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
        richedit1.Text:=memo1.Text;
        if pd1.Execute then
           richedit1.Print(richedit1.Text);
end;

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

end;

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

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

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

procedure TForm2.N17Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
    form3:=tform3.Create(application);
    form3.ShowModal;
end;

procedure TForm2.N19Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
    form4:=tform4.Create(application);
    form4.ShowModal;
end;

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

procedure TForm2.N42Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
   if selectdirectory(dir,[sdallowcreate,sdperformcreate,sdprompt],0) then
   begin
      form1.Label1.Caption:='你要压缩的文件目录是:';
      form1.Label2.Caption:=dir;
      form1.ShowModal;
       bitbtn4.Click;
     end;
end;

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

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

procedure TForm2.BitBtn6MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    // playsound(pchar('menu1'),hinstance,snd_async or snd_resource);
end;

procedure TForm2.BitBtn8Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
form8:=tform8.Create(application);
form8.ShowModal;
end;

procedure TForm2.BitBtn1Click(Sender: TObject);
var
sei:tshellexecuteinfo;
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
try
begin
if shelllistview1.SelectedFolder.PathName<>''then
  begin
    fillchar(sei,sizeof(sei),#0);
    sei.cbSize:=sizeof(sei);
    sei.lpFile:=pchar(shelllistview1.SelectedFolder.PathName);
    sei.lpVerb:='properties';
    sei.fMask:=SEE_MASK_INVOKEIDLIST;
    shellexecuteex(@sei);
 end else
    messagedlg('您还没有在文件列表中选择文件或者文件夹!',mtwarning,[mbok],0);
    end;
    except
     messagedlg('您还没有在文件列表中选择文件或者文件夹!',mtwarning,[mbok],0);
end;
end;
procedure TForm2.N11Click(Sender: TObject);
begin
playsound(pchar('down1'),hinstance,snd_async or snd_resource);
bitbtn10.Click;
end;

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

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

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

procedure TForm2.N20Click(Sender: TObject);
begin
   playsound(pchar('down1'),hinstance,snd_async or snd_resource);
   //shellexecute(handle,nil,pchar('http://lovesky1984.home.bj001.net'),nil,nil,sw_shownormal);
   form9:=tform9.Create(application);
   form9.ShowModal;
end;

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

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

procedure TForm2.N50Click(Sender: TObject);
begin
    bitbtn7.Click;
end;

procedure TForm2.N48Click(Sender: TObject);
begin
   form7:=tform7.Create(application);
   form7.ShowModal;
end;

procedure TForm2.N51Click(Sender: TObject);
begin
   form10:=tform10.Create(application);
   form10.ShowModal;
end;

procedure TForm2.BitBtn12Click(Sender: TObject);
begin
 playsound(pchar('down1'),hinstance,snd_async or snd_resource);
     form6:=tform6.Create(application);
     form6.ShowModal;
end;

end.