发信人: kingron(金龍)
整理人: teleme(2001-03-05 18:03:47), 站内信件
|
完整的例子在我的主页有下载： http://kingron.myetang.com/-->软件下载
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=321024;
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.
【 在 gdxkz 的大作中提到：】
:这个过程的原理是怎么样的？
:......
----
██████
█┏━━┓█
█┃之金┃█ Delphi版直达快车
█┃印龍┃█
█┗━━┛█
██████ |
|