难得在家闲时,发现以前用VC写的文件萃取软件用起来很不爽;刚刚学会Delphi,练习一下。
.pas 文件:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Mask, Buttons, ExtCtrls, DBCtrls, DB, ADODB,FileCtrl,
Menus;
type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
ADOQuery1: TADOQuery;
DataSource1: TDataSource;
ADOQuery1ID: TAutoIncField;
ADOQuery1Type: TWideStringField;
ADOQuery1Path: TWideStringField;
ADOQuery1FileExt: TWideStringField;
ADOQuery1Split: TWideStringField;
ADOQuery1ObjFile: TWideStringField;
Panel7: TPanel;
Memo1: TMemo;
Panel8: TPanel;
GroupBox1: TGroupBox;
DBRadioGroup2: TDBRadioGroup;
GroupBox2: TGroupBox;
FNListBox: TListBox;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
BitBtn3: TBitBtn;
Panel4: TPanel;
Panel5: TPanel;
DBText1: TDBText;
DriveComboBox1: TDriveComboBox;
Panel6: TPanel;
DirectoryListBox1: TDirectoryListBox;
DBRadioGroup1: TDBRadioGroup;
GroupBox3: TGroupBox;
DBRadioGroup3: TDBRadioGroup;
DBRadioGroup4: TDBRadioGroup;
BitBtn1: TBitBtn;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
BitBtn2: TBitBtn;
ListBox1: TListBox;
BitBtn6: TBitBtn;
BitBtn7: TBitBtn;
EditPre: TEdit;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure DBRadioGroup1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure DirectoryListBox1Change(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure BitBtn7Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure MakeTree;
procedure ChangUIStyle();
procedure CopyFilesToClipboard(FileList: string);
end;
var
Form1: TForm1;
// Tree ...
TreeCount,FilesCount,DirsCount:integer;
TreeSize,FilesSize,DirsSize:comp;
const
SELDIRHELP = 10000;
var
Namestr:String;
CurType:Integer;
CurFileEx:Integer;
CurSplit:Integer;
CurTaget:Integer;
CurIcon:Integer;
implementation
uses Exchange,shlobj,activex,clipbrd,shellapi;
{$R *.dfm}
procedure TForm1.MakeTree;
var _Sr : TSearchRec;
I: Integer;
_Error,CurCount : integer;
TrSize, FilePath, FileEx, FileEx1,FullName : string;
CurPath :String;
bRep:Boolean;
Begin
bRep:=false;
_Error:=FindFirst( '*.*',$37,_Sr) ;
While (_Error = 0) do
begin
if _Sr.Name[1]<>'.' then
begin
FilePath:=ExpandFileName(_Sr.Name);
TreeSize:=TreeSize+_Sr.Size;
TrSize:=FloatToStr(TreeSize);
Form1.Caption:=DirectoryListBox1.Directory+' '+IntToStr(TreeCount)
+' files and folders Size: '+TrSize;
if (_Sr.Attr and faDirectory)=0 then
begin
FilesSize:=FilesSize+_Sr.Size;
inc(FilesCount);
// 分析文件扩展名
FileEx := DBRadioGroup2.Items[DBRadioGroup2.ItemIndex];
FileEx1 := ExtractFileExt( _Sr.Name);
if CompareStr( FileEx, FileEx1 ) = 0 then
begin
// FullName:= DirectoryListBox1.Directory + '/'+ _Sr.Name;
CurPath := GetCurrentDir();
FullName:= CurPath + '/'+ _Sr.Name;
CurCount:=FNListBox.Items.Count;
for I := 0 to CurCount-1 do // Iterate
begin
if CompareStr( FullName,FNListBox.Items.Strings[I]) = 0 then
bRep:=true;
end; // for
if bRep = false then
begin
FNListBox.Items.Add(FullName);
ListBox1.Items.Add( _Sr.Name );
end;
end;
//ShowMessage(DirectoryListBox1.Directory + '/' + _Sr.Name );
end;
inc(TreeCount);
end;
{ Begin Recursion }
If ((_Sr.Attr and faDirectory)<>0)AND(_Sr.Name[1] <> '.') then
begin
DirsSize:=DirsSize+_Sr.Size;
inc(DirsCount);
ChDir(_Sr.Name) ;
MakeTree ;
ChDir('..') ;
end ;
{ End Recursion }
_Error:=FindNext(_Sr) ;
end ;
End;
(*var
f1:File;
begin
AssignFile(f1,'c:/test.dat');
try
reset(f1);
seek(f1,pos0); //定位到第200个字节处,位置你可以自己定
read(f1,aa); //读出一个字节,赋值给aa
aa:=mValue; //修改aa的值
seek(f1,pos0); //重新定位,因为读数据后,指针指向了下一个字节
write(f1,aa); //将修改后的值写回原位
finally
closeFile(f1);
end; //end of try
end;
*)
procedure TForm1.Button1Click(Sender: TObject) ;
var
Dir: string;
begin
Dir := ExtractFilepath(Application.Exename);
if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],SELDIRHELP) then
begin
DataSource1.Edit;
DataSource1.DataSet.FieldByName('Path').Value := Dir;
end;
// DBText1.Caption := Dir;
end;
(*begin
//
OpenDialog1.InitialDir:=ExtractFilepath(Application.Exename);
OpenDialog1.Filter:='文本文件(*.dat;*.DAT)|*.dat;*.DAT';
OpenDialog1.Title:='请选择二进制文件';
if( OpenDialog1.Execute = true ) then
begin
Namestr := OpenDialog1.FileName;
Label_Name.Caption := Namestr;
end;
end;
*)
procedure TForm1.ChangUIStyle();
var
s1: string;
i:integer;
begin
s1:=DBRadioGroup1.Items[DBRadioGroup1.ItemIndex];
if Pos('VTK', s1)>0 then
begin
CurType := 1;
end
else if Pos('ITK',s1)>0 then
begin
CurType := 2;
end else begin
CurType := 3;
end;
//
DBText1.Caption:=DataSource1.DataSet.FieldByName('Path').AsString;
DirectoryListBox1.Directory := DataSource1.DataSet.FieldByName('Path').AsString;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.Title := '文件萃取';
CurIcon := 1;
Application.Icon.LoadFromFile( ExtractFilePath(Application.ExeName) + '1.ico');
TRy
// 动态建立连接
ADOConnection1.ConnectionString:='Provider=MSDASQL.1;Password="";Persist Security Info=True;User ID=Admin;'
+ 'Data Source=MS Access Database;User ID=Admin;Data Source=MS Access Database;Initial Catalog='
+ ExtractFilePath(Application.ExeName)
+ 'NameExtracter.mdb';
ADOConnection1.Open();
ADOConnection1.Connected:=False;
ADOConnection1.Connected:=True;
ADOQuery1.Open; ADOQuery1.Requery;
if DataSource1.State in [dsEdit, dsInsert] then ADOQuery1.Post;
except
ShowMessage('数据库连接出现错误');
exit;
end;
CurType:=0;
CurFileEx:=0;
CurSplit:=0;
CurTaget:=0;
ChangUIStyle;
end;
procedure TForm1.DBRadioGroup1Click(Sender: TObject);
begin
ChangUIStyle;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if DataSource1.State in [dsEdit, dsInsert] then ADOQuery1.Post;
ADOConnection1.Connected := false;
end;
procedure TForm1.DirectoryListBox1Change(Sender: TObject);
begin
DBText1.Caption := DirectoryListBox1.Directory;
DataSource1.Edit;
DataSource1.DataSet.FieldByName('Path').Value := DirectoryListBox1.Directory;
end;
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
TreeCount:=1;
FilesCount:=0;
DirsCount:=0;
TreeSize:=0;
FilesSize:=0;
DirsSize:=0;
ChDir(DirectoryListBox1.Directory);
FNListBox.Clear;
ListBox1.Clear;
MakeTree;
///
Memo1.Lines.Clear;
Memo1.Lines.Add(FloatToStr(DirsCount)+' folders ');
Memo1.Lines.Add(FloatToStr(FilesCount)+' files '
+FloatToStr(FilesSize)+' bytes');
Memo1.Lines.Add(FloatToStrF(FilesSize/1024, ffNumber, 12, 2)+' kilobytes');
Memo1.Lines.Add('In tree '+DirectoryListBox1.Directory);
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
I: Integer;
begin
for I := 0 to FNListBox.Count - 1 do // Iterate
begin
ListBox1.Items.Strings[I] := FNListBox.Items.Strings[I];
end; // for
end;
procedure TForm1.BitBtn4Click(Sender: TObject);
var
I: Integer;
PreS:String;
begin
PreS := EditPre.Text;
for I := 0 to FNListBox.Count - 1 do // Iterate
begin
// if PreS<>'' then
ListBox1.Items.Strings[I] := PreS + ExtractFileName( FNListBox.Items.Strings[I] );
end; // for
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
var
I: Integer;
FileList,strT:String;
begin
FileList := '';
for I := 0 to FNListBox.Count - 1 do // Iterate
begin
strT := FNListBox.Items.Strings[I];
if I = 0 then
FileList := strT
else
FileList := FileList + ''#0''+ strT;
end; // for
CopyFilesToClipboard( FileList );
// 'C:/Downloads/Movie/aaaa.dll'#0'C:/log2.txt' );
// FileList ); // 'C:/log2.txt'#0'C:/test.dat');
end;
procedure TForm1.CopyFilesToClipboard(FileList: string);
var
DropFiles: PDropFiles;
hGlobal: THandle;
iLen: Integer;
begin
iLen := Length(FileList) + 2;
FileList := FileList + #0#0;
hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT,
SizeOf(TDropFiles) + iLen);
if (hGlobal = 0) then raise Exception.Create('Could not allocate memory.');
begin
DropFiles := GlobalLock(hGlobal);
DropFiles^.pFiles := SizeOf(TDropFiles);
Move(FileList[1], (PChar(DropFiles) + SizeOf(TDropFiles))^, iLen);
GlobalUnlock(hGlobal);
Clipboard.SetAsHandle(CF_HDROP, hGlobal);
end;
end;
procedure TForm1.BitBtn5Click(Sender: TObject);
var
I: Integer;
FSpit,FormatStr:String;
begin
FormatStr:='';
case DBRadioGroup3.ItemIndex of //
0: FSpit:=';';
1: FSpit:=',';
2: FSpit:=' ';
3: FSpit:=';';
end; // case
for I := 0 to ListBox1.Count - 1 do // Iterate
begin
if I=0 then
FormatStr:=FormatStr+ ListBox1.Items.Strings[I]
else
FormatStr:=FormatStr+ FSpit + ListBox1.Items.Strings[I]
end; // for
Memo1.Clear;
Memo1.Enabled:=true;
Memo1.Text := FormatStr;
end;
procedure TForm1.BitBtn6Click(Sender: TObject);
begin
ShellExecute(Handle,'open', 'mailto:realpersuper@yahoo.com.cn?Subject=点击发送即可&body=不必写内容,除非你想写' ,nil,nil,SW_SHOW);
end;
procedure TForm1.N1Click(Sender: TObject);
begin
ListBox1.Clear;
FNListBox.Clear;
end;
procedure TForm1.BitBtn7Click(Sender: TObject);
begin
//
PostMessage(Form1.handle, WM_Close, 0, 0);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Inc( CurIcon );
CurIcon := CurIcon mod 9;
Application.Icon.LoadFromFile( ExtractFilePath(Application.ExeName) + IntToStr(CurIcon+1) +'.ico');
end;
end.
http://dl2.csdn.net/down4/20070801/01235621549.rar
.pas 文件:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Mask, Buttons, ExtCtrls, DBCtrls, DB, ADODB,FileCtrl,
Menus;
type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
ADOQuery1: TADOQuery;
DataSource1: TDataSource;
ADOQuery1ID: TAutoIncField;
ADOQuery1Type: TWideStringField;
ADOQuery1Path: TWideStringField;
ADOQuery1FileExt: TWideStringField;
ADOQuery1Split: TWideStringField;
ADOQuery1ObjFile: TWideStringField;
Panel7: TPanel;
Memo1: TMemo;
Panel8: TPanel;
GroupBox1: TGroupBox;
DBRadioGroup2: TDBRadioGroup;
GroupBox2: TGroupBox;
FNListBox: TListBox;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
BitBtn3: TBitBtn;
Panel4: TPanel;
Panel5: TPanel;
DBText1: TDBText;
DriveComboBox1: TDriveComboBox;
Panel6: TPanel;
DirectoryListBox1: TDirectoryListBox;
DBRadioGroup1: TDBRadioGroup;
GroupBox3: TGroupBox;
DBRadioGroup3: TDBRadioGroup;
DBRadioGroup4: TDBRadioGroup;
BitBtn1: TBitBtn;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
BitBtn2: TBitBtn;
ListBox1: TListBox;
BitBtn6: TBitBtn;
BitBtn7: TBitBtn;
EditPre: TEdit;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure DBRadioGroup1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure DirectoryListBox1Change(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure BitBtn7Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure MakeTree;
procedure ChangUIStyle();
procedure CopyFilesToClipboard(FileList: string);
end;
var
Form1: TForm1;
// Tree ...
TreeCount,FilesCount,DirsCount:integer;
TreeSize,FilesSize,DirsSize:comp;
const
SELDIRHELP = 10000;
var
Namestr:String;
CurType:Integer;
CurFileEx:Integer;
CurSplit:Integer;
CurTaget:Integer;
CurIcon:Integer;
implementation
uses Exchange,shlobj,activex,clipbrd,shellapi;
{$R *.dfm}
procedure TForm1.MakeTree;
var _Sr : TSearchRec;
I: Integer;
_Error,CurCount : integer;
TrSize, FilePath, FileEx, FileEx1,FullName : string;
CurPath :String;
bRep:Boolean;
Begin
bRep:=false;
_Error:=FindFirst( '*.*',$37,_Sr) ;
While (_Error = 0) do
begin
if _Sr.Name[1]<>'.' then
begin
FilePath:=ExpandFileName(_Sr.Name);
TreeSize:=TreeSize+_Sr.Size;
TrSize:=FloatToStr(TreeSize);
Form1.Caption:=DirectoryListBox1.Directory+' '+IntToStr(TreeCount)
+' files and folders Size: '+TrSize;
if (_Sr.Attr and faDirectory)=0 then
begin
FilesSize:=FilesSize+_Sr.Size;
inc(FilesCount);
// 分析文件扩展名
FileEx := DBRadioGroup2.Items[DBRadioGroup2.ItemIndex];
FileEx1 := ExtractFileExt( _Sr.Name);
if CompareStr( FileEx, FileEx1 ) = 0 then
begin
// FullName:= DirectoryListBox1.Directory + '/'+ _Sr.Name;
CurPath := GetCurrentDir();
FullName:= CurPath + '/'+ _Sr.Name;
CurCount:=FNListBox.Items.Count;
for I := 0 to CurCount-1 do // Iterate
begin
if CompareStr( FullName,FNListBox.Items.Strings[I]) = 0 then
bRep:=true;
end; // for
if bRep = false then
begin
FNListBox.Items.Add(FullName);
ListBox1.Items.Add( _Sr.Name );
end;
end;
//ShowMessage(DirectoryListBox1.Directory + '/' + _Sr.Name );
end;
inc(TreeCount);
end;
{ Begin Recursion }
If ((_Sr.Attr and faDirectory)<>0)AND(_Sr.Name[1] <> '.') then
begin
DirsSize:=DirsSize+_Sr.Size;
inc(DirsCount);
ChDir(_Sr.Name) ;
MakeTree ;
ChDir('..') ;
end ;
{ End Recursion }
_Error:=FindNext(_Sr) ;
end ;
End;
(*var
f1:File;
begin
AssignFile(f1,'c:/test.dat');
try
reset(f1);
seek(f1,pos0); //定位到第200个字节处,位置你可以自己定
read(f1,aa); //读出一个字节,赋值给aa
aa:=mValue; //修改aa的值
seek(f1,pos0); //重新定位,因为读数据后,指针指向了下一个字节
write(f1,aa); //将修改后的值写回原位
finally
closeFile(f1);
end; //end of try
end;
*)
procedure TForm1.Button1Click(Sender: TObject) ;
var
Dir: string;
begin
Dir := ExtractFilepath(Application.Exename);
if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],SELDIRHELP) then
begin
DataSource1.Edit;
DataSource1.DataSet.FieldByName('Path').Value := Dir;
end;
// DBText1.Caption := Dir;
end;
(*begin
//
OpenDialog1.InitialDir:=ExtractFilepath(Application.Exename);
OpenDialog1.Filter:='文本文件(*.dat;*.DAT)|*.dat;*.DAT';
OpenDialog1.Title:='请选择二进制文件';
if( OpenDialog1.Execute = true ) then
begin
Namestr := OpenDialog1.FileName;
Label_Name.Caption := Namestr;
end;
end;
*)
procedure TForm1.ChangUIStyle();
var
s1: string;
i:integer;
begin
s1:=DBRadioGroup1.Items[DBRadioGroup1.ItemIndex];
if Pos('VTK', s1)>0 then
begin
CurType := 1;
end
else if Pos('ITK',s1)>0 then
begin
CurType := 2;
end else begin
CurType := 3;
end;
//
DBText1.Caption:=DataSource1.DataSet.FieldByName('Path').AsString;
DirectoryListBox1.Directory := DataSource1.DataSet.FieldByName('Path').AsString;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.Title := '文件萃取';
CurIcon := 1;
Application.Icon.LoadFromFile( ExtractFilePath(Application.ExeName) + '1.ico');
TRy
// 动态建立连接
ADOConnection1.ConnectionString:='Provider=MSDASQL.1;Password="";Persist Security Info=True;User ID=Admin;'
+ 'Data Source=MS Access Database;User ID=Admin;Data Source=MS Access Database;Initial Catalog='
+ ExtractFilePath(Application.ExeName)
+ 'NameExtracter.mdb';
ADOConnection1.Open();
ADOConnection1.Connected:=False;
ADOConnection1.Connected:=True;
ADOQuery1.Open; ADOQuery1.Requery;
if DataSource1.State in [dsEdit, dsInsert] then ADOQuery1.Post;
except
ShowMessage('数据库连接出现错误');
exit;
end;
CurType:=0;
CurFileEx:=0;
CurSplit:=0;
CurTaget:=0;
ChangUIStyle;
end;
procedure TForm1.DBRadioGroup1Click(Sender: TObject);
begin
ChangUIStyle;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if DataSource1.State in [dsEdit, dsInsert] then ADOQuery1.Post;
ADOConnection1.Connected := false;
end;
procedure TForm1.DirectoryListBox1Change(Sender: TObject);
begin
DBText1.Caption := DirectoryListBox1.Directory;
DataSource1.Edit;
DataSource1.DataSet.FieldByName('Path').Value := DirectoryListBox1.Directory;
end;
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
TreeCount:=1;
FilesCount:=0;
DirsCount:=0;
TreeSize:=0;
FilesSize:=0;
DirsSize:=0;
ChDir(DirectoryListBox1.Directory);
FNListBox.Clear;
ListBox1.Clear;
MakeTree;
///
Memo1.Lines.Clear;
Memo1.Lines.Add(FloatToStr(DirsCount)+' folders ');
Memo1.Lines.Add(FloatToStr(FilesCount)+' files '
+FloatToStr(FilesSize)+' bytes');
Memo1.Lines.Add(FloatToStrF(FilesSize/1024, ffNumber, 12, 2)+' kilobytes');
Memo1.Lines.Add('In tree '+DirectoryListBox1.Directory);
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
I: Integer;
begin
for I := 0 to FNListBox.Count - 1 do // Iterate
begin
ListBox1.Items.Strings[I] := FNListBox.Items.Strings[I];
end; // for
end;
procedure TForm1.BitBtn4Click(Sender: TObject);
var
I: Integer;
PreS:String;
begin
PreS := EditPre.Text;
for I := 0 to FNListBox.Count - 1 do // Iterate
begin
// if PreS<>'' then
ListBox1.Items.Strings[I] := PreS + ExtractFileName( FNListBox.Items.Strings[I] );
end; // for
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
var
I: Integer;
FileList,strT:String;
begin
FileList := '';
for I := 0 to FNListBox.Count - 1 do // Iterate
begin
strT := FNListBox.Items.Strings[I];
if I = 0 then
FileList := strT
else
FileList := FileList + ''#0''+ strT;
end; // for
CopyFilesToClipboard( FileList );
// 'C:/Downloads/Movie/aaaa.dll'#0'C:/log2.txt' );
// FileList ); // 'C:/log2.txt'#0'C:/test.dat');
end;
procedure TForm1.CopyFilesToClipboard(FileList: string);
var
DropFiles: PDropFiles;
hGlobal: THandle;
iLen: Integer;
begin
iLen := Length(FileList) + 2;
FileList := FileList + #0#0;
hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT,
SizeOf(TDropFiles) + iLen);
if (hGlobal = 0) then raise Exception.Create('Could not allocate memory.');
begin
DropFiles := GlobalLock(hGlobal);
DropFiles^.pFiles := SizeOf(TDropFiles);
Move(FileList[1], (PChar(DropFiles) + SizeOf(TDropFiles))^, iLen);
GlobalUnlock(hGlobal);
Clipboard.SetAsHandle(CF_HDROP, hGlobal);
end;
end;
procedure TForm1.BitBtn5Click(Sender: TObject);
var
I: Integer;
FSpit,FormatStr:String;
begin
FormatStr:='';
case DBRadioGroup3.ItemIndex of //
0: FSpit:=';';
1: FSpit:=',';
2: FSpit:=' ';
3: FSpit:=';';
end; // case
for I := 0 to ListBox1.Count - 1 do // Iterate
begin
if I=0 then
FormatStr:=FormatStr+ ListBox1.Items.Strings[I]
else
FormatStr:=FormatStr+ FSpit + ListBox1.Items.Strings[I]
end; // for
Memo1.Clear;
Memo1.Enabled:=true;
Memo1.Text := FormatStr;
end;
procedure TForm1.BitBtn6Click(Sender: TObject);
begin
ShellExecute(Handle,'open', 'mailto:realpersuper@yahoo.com.cn?Subject=点击发送即可&body=不必写内容,除非你想写' ,nil,nil,SW_SHOW);
end;
procedure TForm1.N1Click(Sender: TObject);
begin
ListBox1.Clear;
FNListBox.Clear;
end;
procedure TForm1.BitBtn7Click(Sender: TObject);
begin
//
PostMessage(Form1.handle, WM_Close, 0, 0);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Inc( CurIcon );
CurIcon := CurIcon mod 9;
Application.Icon.LoadFromFile( ExtractFilePath(Application.ExeName) + IntToStr(CurIcon+1) +'.ico');
end;
end.
http://dl2.csdn.net/down4/20070801/01235621549.rar