]、。·ˉˇ¨〃々—～‖…’”〕〉》」』〗】∶！＂＇），．：；？］｀ unit mgr;

interface

uses

 Windows, Messages, SysUtils, Classes, Forms,

 StdCtrls,shlobj, Controls, Dialogs,shellapi;

type

 TForm1 = class(TForm)

   GroupBox1: TGroupBox;

   Button1: TButton;

   OpenDialog1: TOpenDialog;

   SaveDialog1: TSaveDialog;

   Button3: TButton;

   GroupBox2: TGroupBox;

   ListBox1: TListBox;

   procedure Button1Click(Sender: TObject);

   procedure Button3Click(Sender: TObject);

   procedure FormCreate(Sender: TObject);

   procedure SaveDialog1CanClose(Sender: TObject; var CanClose: Boolean);

   procedure ListBox1DblClick(Sender: TObject);

   procedure FormDestroy(Sender: TObject);

 private

   { Private declarations }

   fstream1:tfilestream;

   fstream2:tfilestream;

   list:tstrings;

   len:tstrings;

 public

   { Public declarations }

 end;

var

 Form1: TForm1;

implementation

{$R *.DFM}

const

 flen=136192;  //请注意修改这儿的长度

type

 FILE_INFO=record

   filename:array[0..MAX_PATH] of char;

   len:integer;

 end;

function SelectDirectory(handle:hwnd;const Caption: string; const Root: WideString;out Directory: string): Boolean;

var

 lpbi:_browseinfo;

 buf:array [0..MAX_PATH] of char;

 id:ishellfolder;

 eaten,att:cardinal;

 rt:pitemidlist;

 initdir:pwidechar;

begin

 result:=false;

 lpbi.hwndOwner:=handle;

 lpbi.lpfn:=nil;

 lpbi.lpszTitle:=pchar(caption);

 lpbi.ulFlags:=BIF_RETURNONLYFSDIRS+BIF_EDITBOX;

 SHGetDesktopFolder(id);

 initdir:=pwchar(root);

 id.ParseDisplayName(0,nil,initdir,eaten,rt,att);

 lpbi.pidlRoot:=rt;

 getmem(lpbi.pszDisplayName,MAX_PATH);

 try

  result:=shgetpathfromidlist(shbrowseforfolder(lpbi),buf);

 except

  freemem(lpbi.pszDisplayName);

 end;

 if result then

 begin

  directory:=buf;

  if length(directory)<>3 then directory:=directory+'\';

 end;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

 info:FILE_INFO;

 i:integer;

 buf:array[0..4096] of byte;

 s:integer;

begin

 if savedialog1.Execute then

 if opendialog1.Execute then

 begin

   try

     copyfile(pchar(paramstr(0)),pchar(savedialog1.FileName),false);

     fstream1:=tfilestream.Create(pchar(savedialog1.FileName),fmopenreadwrite);

     fstream1.Seek(flen,soFromBeginning);

     for i:=0 to opendialog1.Files.Count-1 do

     begin

       strpcopy(info.filename,extractfilename(opendialog1.files.strings[i]));

       fstream2:=tfilestream.Create(opendialog1.Files.Strings[i],fmopenread);

       info.len:=fstream2.Size;

       fstream1.Write(info,sizeof(info));

       while fstream2.Position<>fstream2.Size do

       begin

       s:=fstream2.Read(buf,sizeof(buf));

       fstream1.Write(buf,s);

       end;

       fstream2.Free;

     end;

   finally

     fstream1.Free;

   end;

 end;

end;

procedure TForm1.Button3Click(Sender: TObject);

var

 f:textfile;

 info:FILE_INFO;

 i:integer;

 buf:array[0..4096] of byte;

 s:integer;

 count,b:integer;

 dir:string;

begin

if selectdirectory(handle,'选择输出文件夹','',dir) then

  try

     fstream1:=tfilestream.Create(paramstr(0),fmShareDenyWrite);

     fstream1.Seek(flen,soFromBeginning);

     while fstream1.Position<>fstream1.Size do

     begin

       fstream1.Read(info,sizeof(info));

       count:=0;

       assignfile(f,dir+info.filename);

       rewrite(f);

       closefile(f);

       fstream2:=tfilestream.Create(dir+info.filename,fmopenwrite);

       fstream2.Size:=0;

       i:=info.len div sizeof(buf);

       for b:=1 to i do

       begin

       s:=fstream1.Read(buf,sizeof(buf));

       fstream2.Write(buf,s);

       inc(count,s);

       end;

       s:=fstream1.Read(buf,info.len-count);

       fstream2.Write(buf,s);

       fstream2.Free;

     end;

   finally

     fstream1.Free;

 end;

end;

procedure TForm1.FormCreate(Sender: TObject);

var

 info:FILE_INFO;

begin

  list:=tstringlist.Create;

  len:=tstringlist.Create;

  try

     fstream1:=tfilestream.Create(paramstr(0),fmShareDenyWrite);

     fstream1.Seek(flen,soFromBeginning);

     while fstream1.Position<>fstream1.Size do

     begin

       fstream1.Read(info,sizeof(info));

       list.Add(inttostr(fstream1.position));

       len.Add(inttostr(info.len));

       listbox1.Items.Add(info.filename);

       fstream1.Seek(info.len,soFromCurrent);

     end;

   finally

     fstream1.Free;

 end;

 if listbox1.Items.Count>0 then button3.Enabled:=true else button3.Enabled:=false;

end;

procedure TForm1.SaveDialog1CanClose(Sender: TObject;

 var CanClose: Boolean);

var

 f:integer;

begin

 f:=filecreate(savedialog1.FileName);

 if f<=0 then

 begin

   MessageBox(handle,'不能选择输出到该文件！',pchar(application.Title),MB_OK+MB_ICONerror);

   canclose:=false;

 end;

 fileclose(f);

end;

procedure TForm1.ListBox1DblClick(Sender: TObject);

var

 path:array[0..max_path] of char;

 filename:string;

 f,b,s,count:integer;

 buf:array[0..4096] of char;

begin

 if button3.Enabled=false then exit;

 gettemppath(Max_path,path);

 filename:=path+listbox1.Items.Strings[listbox1.itemindex];

 fstream1:=tfilestream.Create(paramstr(0),fmShareDenyWrite);

 f:=filecreate(filename);

 fileclose(f);

 count:=0;

 fstream2:=tfilestream.Create(filename,fmopenwrite);

 fstream1.Seek(strtoint(list.Strings[listbox1.ItemIndex]),sofrombeginning);

 f:=strtoint(len.Strings[listbox1.itemindex]) div sizeof(buf);

 for b:=1 to f do

 begin

   s:=fstream1.Read(buf,sizeof(buf));

   fstream2.Write(buf,s);

   inc(count,s);

 end;

 s:=fstream1.Read(buf,strtoint(len.Strings[listbox1.itemindex])-count);

 fstream2.Write(buf,s);

 fstream2.Free;

 shellexecute(handle,'open',pchar(filename),'','',sw_show);

 fstream1.Free;

end;

procedure TForm1.FormDestroy(Sender: TObject);

var

i:integer;

path:array[0..max_path] of char;

filename:string;

begin

 list.Free;

 len.Free;

 gettemppath(Max_path,path);

 for i:=0 to listbox1.Items.Count-1 do

 begin

   filename:=path+listbox1.Items.Strings[i];

   deletefile(filename);

 end;

end;

end.