J
jingtao
Unregistered / Unconfirmed
GUEST, unregistred user!
<<电脑商情报>>稿件
谈Delphi编程中文件格式的应用
陈经韬
文件是数据的物理存在方式,是数据的载体.在Windows下,有各种各样格式的文件.文件因格式不同而具体作用也不一样.熟悉文件格式将对我们的编程有莫大帮助.下面,笔者将通过常见的波形文件WAV,VCD视频文件DAT和图标文件ICO来介绍常用的几种文件格式的编程.
一:Wav格式程序编程
Wav格式文件主要由两部分组成:头信息和具体数据.其中头信息部分记录了该Wav文件的声道,位率和频率等信息.声道一般分为单声道和立体声,而位率一般可以分为8位和16位声.至于声音频率可以有1025,22050,44100等多种.也就是说,只要我们定义一个文件头,然后把纯声音数据添加到其后面即可变成一个完整的可以播放的Wav文件.在本例中,我们通过Mediaplay控件来采集声音数据.下面就开始动手吧.
运行Delphi,在System页拖一个Mediaplayer控件到窗体上,默认名为Mediaplayer1。由于我们的程序是采用自己的按钮，所以将Mediaplayer1的Visible属性设置为False，其它属性保持默认值。再放两个按钮Button1和Button2。Button1的属性Name改为BtStart,Caption改为"开始录音", Button2的属性Name改为BtStop,Caption改为"停止录音",Enabled属性改为False。然后切换窗口到代码窗口，开始书写代码。
程序中，我们定义了一个Wav文件的文件头格式，录音时先创建一个只有文件头的Wav文件，然后将Mediaplayer1录制下来的声音写进文件。其中CreateWav过程的几个参数意义如下:第一个channels代表声道，取1时代表单声，取2时代表立体声。resolution也只有两个值可以选择，取8时代表8位声音，取16时代表16位声音，rate则代表声音频率，如11025,22050, 44100。值越大则声音越清晰，当然，所录制的文件也越大。最后一个参数则代表对应的文件名称了。所以CreateWav可以有以下形式:
CreateWav(1,8,11025,'C:/abc.wav');//在C盘根目录下创建一个8位单声道频率为11025的名为abc.wav的Wav文件
CreateWav(2,16,44100,'C:/abc.wav');//在C盘根目录下创建一个16位立体声道频率为44100的名为abc.wav的Wav文件
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, MPlayer;
type
TWavHeader = record //定义一个Wav文件头格式
rId : longint;
rLen : longint;
wId : longint;
fId : longint;
fLen : longint;
wFormatTag : word;
nChannels : word;
nSamplesPerSec : longint;
nAvgBytesPerSec : longint;
nBlockAlign : word;
wBitsPerSample : word;
dId : longint;
wSampleLength : longint;
end;
TForm1 = class(TForm)
MediaPlayer1: TMediaPlayer;
BtStart: TButton;
BtStop: TButton;
procedure CreateWav(channels : word; resolution : word; rate : longint; fn : string);//自定义写一个Wav文件头过程
procedure BtStartClick(Sender: TObject);
procedure BtStopClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.CreateWav( channels : word; { 1(单声)或者2(立体声) }
resolution : word; { 8或者16,代表8位或16位声音 }
rate : longint; { 声音频率,如11025,22050, 44100}
fn : string { 对应的文件名称 } );
var
wf : file of TWavHeader;
wh : TWavHeader;
begin
wh.rId := $46464952;
wh.rLen := 36;
wh.wId := $45564157;
wh.fId := $20746d66;
wh.fLen := 16;
wh.wFormatTag := 1;
wh.nChannels := channels;
wh.nSamplesPerSec := rate;
wh.nAvgBytesPerSec := channels*rate*(resolution div 8);
wh.nBlockAlign := channels*(resolution div 8);
wh.wBitsPerSample := resolution;
wh.dId := $61746164;
wh.wSampleLength := 0;
assignfile(wf,fn); {打开对应文件 }
rewrite(wf); {移动指针到文件头}
write(wf,wh); {写进文件头 }
closefile(wf); {关闭文件 }
end;
procedure TForm1.BtStartClick(Sender: TObject);
begin
try
//在程序当前目录下创建一个Wav文件Temp.wav
CreateWav(1, 8, 11025, (ExtractFilePath(Application.ExeName)+ 'Temp.wav'));
MediaPlayer1.DeviceType := dtAutoSelect;
MediaPlayer1.FileName := (ExtractFilePath(Application.ExeName)+ 'Temp.wav');
MediaPlayer1.Open;
MediaPlayer1.StartRecording;
BtStart.Enabled:=false;
BtStop.Enabled:=true;
except
BtStart.Enabled:=True;
BtStop.Enabled:=false;
Application.MessageBox('媒体设备初始化失败！','错误',MB_ICONERROR+MB_OK);
end;
end;
procedure TForm1.BtStopClick(Sender: TObject);
begin
try
MediaPlayer1.Stop;
MediaPlayer1.Save;
MediaPlayer1.Close;
Application.MessageBox('声音录制完毕!','信息',MB_ICONINFORMATION+MB_OK);
BtStart.Enabled:=True;
BtStop.Enabled:=false;
except
Application.MessageBox('保存声音文件出错!','错误',MB_ICONERROR+MB_OK);
BtStart.Enabled:=True;
BtStop.Enabled:=false;
end;
end;
end.
外国一个很出名的用Delphi编写的远程控制软件Netbus有一个声音监听功能，就是用本文的方法写的。它先把对方的声音录制下来，然后传送回来，达到监听对方的目的。当然，前提是对方必须安装有话筒，否则监听到的是对方播放的声音（如打开解霸或者Readplay播放，运行本程序，就可以把播放的声音录制下来了）。
实际上，现在的网络声音传播技术已经发展到一定阶段，语音对讲和IP电话等也开始成熟。不过它们一般采用的是经过压缩的ACM格式，具体代码可以在我的主页http://www.138soft.com下载。但如果对ACM格式不熟悉的朋友，也可以用本文的方法来制作自己的“录音机”。
补充：
1、录制的文件播放时可能要把音频属性的Wav调大。
2、如果系统安装了其它一些音频驱动程序，则可能录制的Wav文件大小为零，但会同时生成一个TMP结尾的文件，将其扩展名改为Wav就是录制的声音文件。但这种情况很少发生。（机会几乎为零^-^）
3、本程序在Pwin98+Delphi5,运行解霸和Replayer下录制声音通过。
二:VCD视频文件DAT格式程序编程
DAT格式的文件其实属于MPEG1文件.它是在纯MPEG数据的基础上加入了一些控制信息组成的.DAT文件的结构我们可以大概的这样认为
AT文件=DAT文件头+DAT数据.而纯MPEG文件是没有那个头的.
VCD切割程序网上有很多,大部分都是老外写的,而且一般都要收注册费.实际上,如果我们熟识DAT格式的话,完全 可以自己写一个出来.
在DAT文件中,你能经常找到字符串000001ba,但是在它之前,你还能发现好多个字节.它们是几个近乎类似的字节.而且共有的12~13个字节是 00 ff ff ff ff ff ff ff ff ff ff ff 00,我们称它为DAT头吧.这里有解码器所需要的信息,如果是软件解压,他们不是必须的.紧跟其后的是时间戳,如果你够细心,你会发现每一桢得这几个字节是略微有点变化的,变化规律呢?仔细看看,好像跟时间有关啊,呵呵......如果我们现在称以一个DAT头开始，终结于另一个DAT头之间的数据称为一帧,你会发现,DAT的每一帧的长度是固定的,是2352个字节.对于DAT文件,影片时间的长度与文件的大小是有关系的.在DAT中,每秒种将播放75个帧，也就是说每秒播放的字节数是2352*75个字节.
所以,如果我们要切割一个DAT文件中30秒钟到70秒钟之间的内容组成一个新的DAT文件的话,实际上要做的工作如下:先把整个文件头取下来,然后把30秒钟到70秒钟之间的内容添加在其后面即可.其中30秒开始的位置等于DAT头内容大小+2352*75*30,只要SEEK到那个位置开始切割40秒钟的内容即可.(也就是2352*75*40字节.整个新文件的大小为DAT头大小加上2352*75*40字节.
好了.现在只要解决如何找到那个DAT文件的头位置即可.怎么找呢?在整个DAT文件中搜索,找到一个000001BB即可.找到这个位置再加上2352*2字节就是文件头了.有了这些资料,我们已经可以开始写一个DAT切割程序了.全部代码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, MPlayer, ExtCtrls, ComCtrls;
type
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;
GroupBox1: TGroupBox;
Bt_Open: TButton;
Label_Filename: TLabel;
Label_FileSize: TLabel;
Label_VcdTime: TLabel;
GroupBox2: TGroupBox;
StatusBar1: TStatusBar;
Edit_Start: TEdit;
Label1: TLabel;
Label2: TLabel;
Edit_End: TEdit;
Edit_Save1: TEdit;
Bt_Save: TButton;
Bt_Cut: TButton;
Label3: TLabel;
SaveDialog1: TSaveDialog;
procedure Bt_OpenClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Bt_SaveClick(Sender: TObject);
procedure Bt_CutClick(Sender: TObject);
private
iVcdTime:integer;
function GetFileSize(const FileName: string): LongInt;
function GetPacketHead(FileName:String):integer;//查找Dat文件头
function My_CutMpegFile(SourceFile,DestFile:String;StartTime,TimeLength:integer):Boolean;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function TForm1.GetFileSize(const FileName: string): LongInt;
var
SearchRec: TSearchRec;
begin
if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
Result := SearchRec.Size
else Result := 0;
end;
function TForm1.GetPacketHead(FileName:String):integer;
const FORMAT_DATALEN=512*1024;
var
FileStream:TFileStream;
FormatStrings,StringsStream:TStringStream;
iPos:integer;
Mpg1Format:array[1..4]of byte;
iResult:integer;
begin
if not(FileExists(FileName)) then
begin
Result:=$10184;
Exit;
end;
FileStream:=TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
if FileStream.Size<FORMAT_DATALEN then
begin
Result:=$10184+8+2352*2;
Exit;
end;
StringsStream:=TStringStream.Create('');
StringsStream.CopyFrom(FileStream,FORMAT_DATALEN);
FileStream.Free;
FormatStrings:=TStringStream.Create('');
Mpg1Format[1]:=$00;
Mpg1Format[2]:=$00;
Mpg1Format[3]:=$01;
Mpg1Format[4]:=$bb;
FormatStrings.Write(Mpg1Format,Sizeof(Mpg1Format));
iPos:=Pos(FormatStrings.DataString,StringsStream.DataString);
FormatStrings.Free;
StringsStream.Free;
if iPos<=0 then
iResult:=$10184+8+2352*2
else
iResult:=iPos-1+8+2352*2;
Result:=iResult;
end;
function TForm1.My_CutMpegFile(SourceFile,DestFile:String;StartTime,TimeLength:integer):Boolean;
const MyTimeFramSize=2352*75;//每秒钟176400字节
var
MyHeardSize:integer;
MyMpegFile:TFileStream;
MyMemFile:TMemoryStream;
begin
Result:=True;
MyHeardSize:=GetPacketHead(SourceFile);
MyMpegFile:=TFileStream.Create(SourceFile,fmOpenRead or fmShareDenyNone);
MyMemFile:=TMemoryStream.Create;
try
try
MyMemFile.CopyFrom(MyMpegFile,MyHeardSize);
MyMpegFile.Seek(MyHeardSize+MyTimeFramSize*StartTime,soFromBeginning);
MyMemFile.CopyFrom(MyMpegFile,MyTimeFramSize*TimeLength);
MyMemFile.SaveToFile(DestFile);
finally
MyMemFile.Free;
MyMpegFile.Free;
end;
except
Result:=False;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
iVcdTime:=0;
end;
procedure TForm1.Bt_OpenClick(Sender: TObject);
var
MyFileSize:Longint;
iTime:integer;
begin
if OpenDialog1.Execute then
begin
Label_Filename.Caption:=OpenDialog1.FileName;
MyFileSize:=GetFileSize(OpenDialog1.FileName);
iTime:=Trunc((MyFileSize-(GetPacketHead(Label_Filename.Caption)))/(75*2352));
iVcdTime:=iTime;
Label_FileSize.Caption:='文件大小:'+IntToStr(MyFileSize)+'字节';
Label_VcdTime.Caption:='估计总长度:'+IntToStr(iTime)+'秒钟';
Edit_End.Text:=IntToStr(iTime);
end;
end;
procedure TForm1.Bt_SaveClick(Sender: TObject);
begin
if SaveDialog1.Execute then Edit_Save1.Text:=SaveDialog1.FileName;
end;
procedure TForm1.Bt_CutClick(Sender: TObject);
var
iStart,iEnd,Code:integer;
begin
if Not FileExists(Label_Filename.Caption) then
begin
Application.MessageBox('源文件不存在,请重新选择!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if Edit_Save1.Text='' then
begin
Application.MessageBox('请先选择目标文件名称!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if FileExists(Edit_Save1.Text) then
if(Application.MessageBox('目标文件已经存在,您要覆盖它吗?', Pchar(Application.Title), MB_YESNO +MB_ICONQUESTION) = IDNO)
then Exit;
Val(Edit_Start.Text,iStart,Code);
if Code<>0 then
begin
Application.MessageBox('开始时间必须为整数,请重新输入!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
Val(Edit_End.Text,iEnd,Code);
if Code<>0 then
begin
Application.MessageBox('时间长度必须为整数,请重新输入!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if iStart<0 then
begin
Application.MessageBox('开始时间必须为正整数,请重新输入!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if iStart>=iVcdTime then
begin
Application.MessageBox('开始时间不能大于或等于文件总长度,请重新输入!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if iEnd>iVcdTime then
begin
Application.MessageBox('时间长度不能大于文件总长度,请重新输入!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if iEnd<=0 then
begin
Application.MessageBox('时间长度必须大于0,请重新输入!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if ((iStart-iEnd)>=iVcdTime) or ((iEnd-iStart)>=iVcdTime) or(((iEnd+iStart)>iVcdTime)) then
begin
Application.MessageBox('实际时间不能大于或等于文件总长度,请重新输入!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
My_CutMpegFile(Label_Filename.Caption,Edit_Save1.Text,iStart,iEnd);
Application.MessageBox('切割完毕!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
end;
end.
可能大家还记得我曾经写过一篇<<用Delphi在局域网中实现网上影院>>,就是在局部网内一台电脑播放视频文件整个局部网的电脑都可以收到.那个采用的是隐形动态共享的办法.但是那个方法有个致命的弱点,就是当播放的是光盘文件而不是磁盘文件的时候,当几个人同时访问光驱就不行了.所以那个是取巧的方法.真正的方法是采用流.或者在数据头伪造Mediaplay Server服务器.这样一来无论是磁盘文件还是光盘文件,实际上都是服务器一台电脑读数据而已,就不会发生上面的情况了.具体程序可以在我的主页http://www.138soft.com下载.但是如果对这些不熟练怎么办?哈哈,你还是可以采用取巧的方法:服务端开两个线程,一个发送文件头,另外一个发送数据.客户端也开两个线程,一个接收数据保存为文件,另外一个播放.比如说每个文件为4MB,接收完第一个后开始播放同时继续接收第二个.播放完第一个就删除并播放第二个文件.实际上,早期的DVB就是这样做的.
三:图标文件ICO格式程序编程
Windows下的可执行文件大多都有一个图标的.如果这个程序是你自己编写的,那么你可以轻松的在编译为EXE之前把图标更换掉.但是如果这个EXE不是你的呢?怎么办?当然是用工具了.ResHacker(资源黑客)就是一个很好的工具.但是如果想自己编写程序来实现呢?
图标在可执行文件里面实际上是一项资源.Windows提供了一个API函数来取出EXE里面的图标.函数原型为:HICON ExtractIcon(HINSTANCE hInst,LPCTSTR lpszExeFileName,UINT nIconIndex);其中第一个参数为实例句柄,第二个参数为需要操作的EXE,DLL,BMP或ICON等包含有图标资源的文件名,第三个参数为需要取出的图标在该EXE里面的索引(因为一个EXE文件里面可能含有多个图标).如果这个参数为0,那么将返回第一个图标,如果这个参数为-1,将返回该文件可能含有的所有图标数.如果该文件含有该索引图标,函数将返回该图标的句柄,否则返回值NULL.
那么,到底我们应该怎么样才能更换一个EXE的图标呢?如果你熟悉PE文件结构的话就很简单了.不过PE文件格式是比较复杂的,讲述它的话要费很大篇幅.实际上,你可以这样简单的看一个EXE文件的组成:EXE文件=文件头之类+图标资源+文件尾.也就是说,你不用管它的文件头和文件尾之类,只要找到图标在该EXE里面的位置,然后用你的图标覆盖它即可.
不过需要注意的是,图标是有多种格式的,比如说16X16的16色,32X32的16色,16X16的32色等等.用这种方法更换图标的话必须注意格式要一致.另外,ExtractIcon函数返回的将是32X32的16色图标.这是个很有趣的地方.也就是说,无论你操作的文件或图标格式是怎么样,它取出的都是32X32的16色图标.而Delphi默认的那个图标就是这个格式的.
我们打开Delphi,新建一个工程.直接编译后退出.这个得到的EXE我们将用来做"实验品".再新建一个工程,这个才是我们真正要写的程序.往窗口添加两个名字分别为Next_Icon, Prev_Icon的TSpeedButton.作用是枚举图标的.添加一个Image1用来显示图标.一个名为Edit_SourceFile的TEdit用来显示选择要取出的EXE之类的文件名称.一个OpenDialog,一个SaveDialog和三个Button.最后记得在Use部分添加ShellApi.全部代码如下:
unit Unit1;
interface
uses
ShellApi{必须添加此单元}, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Buttons;
type
TForm1 = class(TForm)
Next_Icon: TSpeedButton;
Prev_Icon: TSpeedButton;
Image1: TImage;
Edit_SourceFile: TEdit;
Button1: TButton;
Button2: TButton;
Button3: TButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
procedure Button1Click(Sender: TObject);
procedure Prev_IconClick(Sender: TObject);
procedure Next_IconClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure Extract_Icon;
function ChangeExeIcon(ExeFile,IconFile:string;Index:Integer=0):Boolean;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Icon_Index: integer;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Caption:='取出图标';
Button2.Caption:='保存图标';
Button3.Caption:='更换图标';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
OpenDialog1.Filter := '所有支持类型(*.EXE,*.DLL,*.OCX,*.ICL,*.ICO,*.BMP)|*.exe;*.dll;*.ocx;*.icl;*.ico;*.bmp|所有文件 (*.*)|*.*';
if OpenDialog1.Execute
then
begin
Edit_SourceFile.Text := OpenDialog1.Filename;
Icon_Index := 0;
Extract_Icon;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
SaveDialog1.Filter :='图标文件(*.ICO)|*.ico';
if SaveDialog1.Execute then
begin
if Copy(SaveDialog1.FileName, Length(SaveDialog1.FileName)-3, 1) = '.' then
Image1.Picture.Icon.SaveToFile(SaveDialog1.FileName)
else
Image1.Picture.Icon.SaveToFile(SaveDialog1.FileName + '.ico');
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
ExeFile:String;
begin
OpenDialog1.Filter := 'EXE文件(*.EXE)|*.exe';
OpenDialog1.Title:='请选择需要更换图标的EXE';
if OpenDialog1.Execute then
begin
ExeFile:=OpenDialog1.FileName;
OpenDialog1.Filter := '图标文件(*.ICO)|*.ico';
OpenDialog1.Title:='请选择需要更换的图标文件';
OpenDialog1.FileName:='';{Clear the Old Filename}
if OpenDialog1.Execute then
if ChangeExeIcon(ExeFile,OpenDialog1.FileName) then
Application.MessageBox('更换图标成功!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK)
else
Application.MessageBox('更换图标失败!',Pchar(Application.Title),MB_ICONERROR+MB_OK)
else
Exit; {Not Select Icon File}
end;
end;
procedure TForm1.Prev_IconClick(Sender: TObject); //枚举前一个图标
begin
if not (FileExists(Edit_SourceFile.Text)) or (Icon_Index <= 0) then Exit;
Icon_Index := Icon_Index - 1;
Extract_Icon;
end;
procedure TForm1.Next_IconClick(Sender: TObject);//枚举下一个图标
begin
if not (FileExists(Edit_SourceFile.Text)) then Exit;
Icon_Index := Icon_Index + 1;
Extract_Icon;
end;
procedure TForm1.Extract_Icon;
var
icon_handle: Longint;
buffer: array[0..1024] of Char;
begin
if not (FileExists(Edit_SourceFile.Text)) then Exit;
StrPCopy(Buffer, Edit_SourceFile.Text);
icon_handle := ExtractIcon(self.Handle, buffer, icon_index);
if Icon_Handle = 0 {Did we get a valid handle back?}
then
begin {No}
if Icon_Index = 0 {Is this the first icon in the file?}
then {Yes. There can't be any icons in this file}
begin
Application.MessageBox('这个文件没有发现图标,请重新选择!','信息',MB_ICONINFORMATION+MB_OK);
Image1.Visible := False;
end
else {No. We must have gone beyond the limit. Step back}
Icon_Index := Icon_Index - 1;
Exit;
end;
{We now have our extracted icon. Save it to a temp file in readiness for the modifocation}
Image1.Picture.Icon.Handle := icon_handle;
Image1.Visible := True;
end;
function TForm1.ChangeExeIcon(ExeFile,IconFile:string;Index:Integer=0):Boolean;
var
TempStream,NewIconMemoryStream:TMemoryStream;
OldIconStrings,ExeStrings,ExeIconStrings:TStringStream;
ExeIcon:TIcon;
IconPosition,IconLength,IconHeadLength:Integer;
IconHandle:HICON;
ExeFileStream,IconFileStream:TFileStream;
begin
Result:=False;
IconHeadLength:=126;
if (not FileExists(ExeFile)) or (not FileExists(IconFile)) then Exit;
try
ExeFileStream:=TFileStream.Create(ExeFile,fmOpenReadWrite+fmShareDenyWrite);
ExeStrings:=TStringStream.Create('');
ExeStrings.Position:=0;
ExeFileStream.Position:=0;
ExeStrings.CopyFrom(ExeFileStream,0);
ExeIcon:=TIcon.Create;
IconHandle:=ExtractIcon(Application.Handle,Pchar(ExeFile),Index);
if IconHandle<=1 then
begin
Application.MessageBox('EXE中没有找到该序列的图标!',Pchar(Application.Title),MB_ICONERROR+MB_OK);
Exit;
end;
ExeIcon.Handle:=IconHandle;
ExeIconStrings:=TStringStream.Create('');
ExeIcon.SaveToStream(ExeIconStrings);
ExeIcon.Free;
ExeIcon:=nil;
IconLength:=ExeIconStrings.Size-IconHeadLength;
ExeIconStrings.Position:=IconHeadLength;
OldIconStrings:=TStringStream.Create('');
OldIconStrings.Position:=0;
ExeIconStrings.Position:=IconHeadLength;
OldIconStrings.CopyFrom(ExeIconStrings,IconLength);
ExeIconStrings.Free;
IconPosition:=Pos(OldIconStrings.DataString,ExeStrings.DataString);
ExeStrings.Free;
ExeStrings:=nil;
OldIconStrings.Free;
IconFileStream:=TFileStream.Create(IconFile,fmOpenRead+fmShareDenyNone);
NewIconMemoryStream:=TMemoryStream.Create;
IconFileStream.Position:=IconHeadLength;
NewIconMemoryStream.Position:=0;
NewIconMemoryStream.CopyFrom(IconFileStream,IconFileStream.Size-IconHeadLength);
IconFileStream.Free;
if IconPosition<=0 then
begin
Application.MessageBox('EXE中没有找到该图标的数据!',Pchar(Application.Title),MB_ICONERROR+MB_OK);
Exit;
end;
if IconLength<>NewIconMemoryStream.Size then
begin
TempStream:=TMemoryStream.Create;
ExeFileStream.Position:=IconPosition+IconLength-1;
TempStream.Position:=0;
TempStream.CopyFrom(ExeFileStream,ExeFileStream.Size-ExeFileStream.Position);
ExeFileStream.Position:=IconPosition-1;
NewIconMemoryStream.Position:=0;
ExeFileStream.CopyFrom(NewIconMemoryStream,0);
TempStream.Position:=0;
ExeFileStream.CopyFrom(TempStream,0);
ExeFileStream.Position:=0;
ExeFileStream.Size:=IconPosition+IconLength-1+TempStream.Size;
TempStream.Free;
end
else
begin
ExeFileStream.Position:=IconPosition-1;
NewIconMemoryStream.Position:=0;
ExeFileStream.CopyFrom(NewIconMemoryStream,0);
end;
NewIconMemoryStream.Free;
Result:=True;
finally
ExeFileStream.Free;
end;
end;
end.
运行程序,点"取出图标",选择一个EXE,然后点"保存图标"将其ICO保存为文件.然后点"更换图标",选择我们刚才编译得到的"实验品"和取出的图标,即可将图标更改掉了.
自定义函数ChangeExeIcon的实现过程如下:先用ExtractIcon将图标释放出来保存为文件,然后将其与EXE比较在该EXE里面找到图标的位置,然后将新图标的内容覆盖原来的图标.实际上,这个查找过程还不够完美,因为它将两者都转化为TStringStream再比较,如果EXE文件很大的话是很费内存的.Delphi本身提供了一个例子用来查找位置的,该例子位于Delphi5/Demos/Resxplor下,读者可以结合它来作出高效的图标更换工具.
★作者:
陈经韬
430074湖北省武汉市武昌民院路湖北经济管理大学计算机系(本)9801班
Home:http://lovejintao.126.com
E-Mail: Lovejingtao@21cn.com
&copy;CopyRight 2000-2003
谈Delphi编程中文件格式的应用
陈经韬
文件是数据的物理存在方式,是数据的载体.在Windows下,有各种各样格式的文件.文件因格式不同而具体作用也不一样.熟悉文件格式将对我们的编程有莫大帮助.下面,笔者将通过常见的波形文件WAV,VCD视频文件DAT和图标文件ICO来介绍常用的几种文件格式的编程.
一:Wav格式程序编程
Wav格式文件主要由两部分组成:头信息和具体数据.其中头信息部分记录了该Wav文件的声道,位率和频率等信息.声道一般分为单声道和立体声,而位率一般可以分为8位和16位声.至于声音频率可以有1025,22050,44100等多种.也就是说,只要我们定义一个文件头,然后把纯声音数据添加到其后面即可变成一个完整的可以播放的Wav文件.在本例中,我们通过Mediaplay控件来采集声音数据.下面就开始动手吧.
运行Delphi,在System页拖一个Mediaplayer控件到窗体上,默认名为Mediaplayer1。由于我们的程序是采用自己的按钮，所以将Mediaplayer1的Visible属性设置为False，其它属性保持默认值。再放两个按钮Button1和Button2。Button1的属性Name改为BtStart,Caption改为"开始录音", Button2的属性Name改为BtStop,Caption改为"停止录音",Enabled属性改为False。然后切换窗口到代码窗口，开始书写代码。
程序中，我们定义了一个Wav文件的文件头格式，录音时先创建一个只有文件头的Wav文件，然后将Mediaplayer1录制下来的声音写进文件。其中CreateWav过程的几个参数意义如下:第一个channels代表声道，取1时代表单声，取2时代表立体声。resolution也只有两个值可以选择，取8时代表8位声音，取16时代表16位声音，rate则代表声音频率，如11025,22050, 44100。值越大则声音越清晰，当然，所录制的文件也越大。最后一个参数则代表对应的文件名称了。所以CreateWav可以有以下形式:
CreateWav(1,8,11025,'C:/abc.wav');//在C盘根目录下创建一个8位单声道频率为11025的名为abc.wav的Wav文件
CreateWav(2,16,44100,'C:/abc.wav');//在C盘根目录下创建一个16位立体声道频率为44100的名为abc.wav的Wav文件
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, MPlayer;
type
TWavHeader = record //定义一个Wav文件头格式
rId : longint;
rLen : longint;
wId : longint;
fId : longint;
fLen : longint;
wFormatTag : word;
nChannels : word;
nSamplesPerSec : longint;
nAvgBytesPerSec : longint;
nBlockAlign : word;
wBitsPerSample : word;
dId : longint;
wSampleLength : longint;
end;
TForm1 = class(TForm)
MediaPlayer1: TMediaPlayer;
BtStart: TButton;
BtStop: TButton;
procedure CreateWav(channels : word; resolution : word; rate : longint; fn : string);//自定义写一个Wav文件头过程
procedure BtStartClick(Sender: TObject);
procedure BtStopClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.CreateWav( channels : word; { 1(单声)或者2(立体声) }
resolution : word; { 8或者16,代表8位或16位声音 }
rate : longint; { 声音频率,如11025,22050, 44100}
fn : string { 对应的文件名称 } );
var
wf : file of TWavHeader;
wh : TWavHeader;
begin
wh.rId := $46464952;
wh.rLen := 36;
wh.wId := $45564157;
wh.fId := $20746d66;
wh.fLen := 16;
wh.wFormatTag := 1;
wh.nChannels := channels;
wh.nSamplesPerSec := rate;
wh.nAvgBytesPerSec := channels*rate*(resolution div 8);
wh.nBlockAlign := channels*(resolution div 8);
wh.wBitsPerSample := resolution;
wh.dId := $61746164;
wh.wSampleLength := 0;
assignfile(wf,fn); {打开对应文件 }
rewrite(wf); {移动指针到文件头}
write(wf,wh); {写进文件头 }
closefile(wf); {关闭文件 }
end;
procedure TForm1.BtStartClick(Sender: TObject);
begin
try
//在程序当前目录下创建一个Wav文件Temp.wav
CreateWav(1, 8, 11025, (ExtractFilePath(Application.ExeName)+ 'Temp.wav'));
MediaPlayer1.DeviceType := dtAutoSelect;
MediaPlayer1.FileName := (ExtractFilePath(Application.ExeName)+ 'Temp.wav');
MediaPlayer1.Open;
MediaPlayer1.StartRecording;
BtStart.Enabled:=false;
BtStop.Enabled:=true;
except
BtStart.Enabled:=True;
BtStop.Enabled:=false;
Application.MessageBox('媒体设备初始化失败！','错误',MB_ICONERROR+MB_OK);
end;
end;
procedure TForm1.BtStopClick(Sender: TObject);
begin
try
MediaPlayer1.Stop;
MediaPlayer1.Save;
MediaPlayer1.Close;
Application.MessageBox('声音录制完毕!','信息',MB_ICONINFORMATION+MB_OK);
BtStart.Enabled:=True;
BtStop.Enabled:=false;
except
Application.MessageBox('保存声音文件出错!','错误',MB_ICONERROR+MB_OK);
BtStart.Enabled:=True;
BtStop.Enabled:=false;
end;
end;
end.
外国一个很出名的用Delphi编写的远程控制软件Netbus有一个声音监听功能，就是用本文的方法写的。它先把对方的声音录制下来，然后传送回来，达到监听对方的目的。当然，前提是对方必须安装有话筒，否则监听到的是对方播放的声音（如打开解霸或者Readplay播放，运行本程序，就可以把播放的声音录制下来了）。
实际上，现在的网络声音传播技术已经发展到一定阶段，语音对讲和IP电话等也开始成熟。不过它们一般采用的是经过压缩的ACM格式，具体代码可以在我的主页http://www.138soft.com下载。但如果对ACM格式不熟悉的朋友，也可以用本文的方法来制作自己的“录音机”。
补充：
1、录制的文件播放时可能要把音频属性的Wav调大。
2、如果系统安装了其它一些音频驱动程序，则可能录制的Wav文件大小为零，但会同时生成一个TMP结尾的文件，将其扩展名改为Wav就是录制的声音文件。但这种情况很少发生。（机会几乎为零^-^）
3、本程序在Pwin98+Delphi5,运行解霸和Replayer下录制声音通过。
二:VCD视频文件DAT格式程序编程
DAT格式的文件其实属于MPEG1文件.它是在纯MPEG数据的基础上加入了一些控制信息组成的.DAT文件的结构我们可以大概的这样认为
AT文件=DAT文件头+DAT数据.而纯MPEG文件是没有那个头的.VCD切割程序网上有很多,大部分都是老外写的,而且一般都要收注册费.实际上,如果我们熟识DAT格式的话,完全 可以自己写一个出来.
在DAT文件中,你能经常找到字符串000001ba,但是在它之前,你还能发现好多个字节.它们是几个近乎类似的字节.而且共有的12~13个字节是 00 ff ff ff ff ff ff ff ff ff ff ff 00,我们称它为DAT头吧.这里有解码器所需要的信息,如果是软件解压,他们不是必须的.紧跟其后的是时间戳,如果你够细心,你会发现每一桢得这几个字节是略微有点变化的,变化规律呢?仔细看看,好像跟时间有关啊,呵呵......如果我们现在称以一个DAT头开始，终结于另一个DAT头之间的数据称为一帧,你会发现,DAT的每一帧的长度是固定的,是2352个字节.对于DAT文件,影片时间的长度与文件的大小是有关系的.在DAT中,每秒种将播放75个帧，也就是说每秒播放的字节数是2352*75个字节.
所以,如果我们要切割一个DAT文件中30秒钟到70秒钟之间的内容组成一个新的DAT文件的话,实际上要做的工作如下:先把整个文件头取下来,然后把30秒钟到70秒钟之间的内容添加在其后面即可.其中30秒开始的位置等于DAT头内容大小+2352*75*30,只要SEEK到那个位置开始切割40秒钟的内容即可.(也就是2352*75*40字节.整个新文件的大小为DAT头大小加上2352*75*40字节.
好了.现在只要解决如何找到那个DAT文件的头位置即可.怎么找呢?在整个DAT文件中搜索,找到一个000001BB即可.找到这个位置再加上2352*2字节就是文件头了.有了这些资料,我们已经可以开始写一个DAT切割程序了.全部代码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, MPlayer, ExtCtrls, ComCtrls;
type
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;
GroupBox1: TGroupBox;
Bt_Open: TButton;
Label_Filename: TLabel;
Label_FileSize: TLabel;
Label_VcdTime: TLabel;
GroupBox2: TGroupBox;
StatusBar1: TStatusBar;
Edit_Start: TEdit;
Label1: TLabel;
Label2: TLabel;
Edit_End: TEdit;
Edit_Save1: TEdit;
Bt_Save: TButton;
Bt_Cut: TButton;
Label3: TLabel;
SaveDialog1: TSaveDialog;
procedure Bt_OpenClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Bt_SaveClick(Sender: TObject);
procedure Bt_CutClick(Sender: TObject);
private
iVcdTime:integer;
function GetFileSize(const FileName: string): LongInt;
function GetPacketHead(FileName:String):integer;//查找Dat文件头
function My_CutMpegFile(SourceFile,DestFile:String;StartTime,TimeLength:integer):Boolean;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function TForm1.GetFileSize(const FileName: string): LongInt;
var
SearchRec: TSearchRec;
begin
if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
Result := SearchRec.Size
else Result := 0;
end;
function TForm1.GetPacketHead(FileName:String):integer;
const FORMAT_DATALEN=512*1024;
var
FileStream:TFileStream;
FormatStrings,StringsStream:TStringStream;
iPos:integer;
Mpg1Format:array[1..4]of byte;
iResult:integer;
begin
if not(FileExists(FileName)) then
begin
Result:=$10184;
Exit;
end;
FileStream:=TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
if FileStream.Size<FORMAT_DATALEN then
begin
Result:=$10184+8+2352*2;
Exit;
end;
StringsStream:=TStringStream.Create('');
StringsStream.CopyFrom(FileStream,FORMAT_DATALEN);
FileStream.Free;
FormatStrings:=TStringStream.Create('');
Mpg1Format[1]:=$00;
Mpg1Format[2]:=$00;
Mpg1Format[3]:=$01;
Mpg1Format[4]:=$bb;
FormatStrings.Write(Mpg1Format,Sizeof(Mpg1Format));
iPos:=Pos(FormatStrings.DataString,StringsStream.DataString);
FormatStrings.Free;
StringsStream.Free;
if iPos<=0 then
iResult:=$10184+8+2352*2
else
iResult:=iPos-1+8+2352*2;
Result:=iResult;
end;
function TForm1.My_CutMpegFile(SourceFile,DestFile:String;StartTime,TimeLength:integer):Boolean;
const MyTimeFramSize=2352*75;//每秒钟176400字节
var
MyHeardSize:integer;
MyMpegFile:TFileStream;
MyMemFile:TMemoryStream;
begin
Result:=True;
MyHeardSize:=GetPacketHead(SourceFile);
MyMpegFile:=TFileStream.Create(SourceFile,fmOpenRead or fmShareDenyNone);
MyMemFile:=TMemoryStream.Create;
try
try
MyMemFile.CopyFrom(MyMpegFile,MyHeardSize);
MyMpegFile.Seek(MyHeardSize+MyTimeFramSize*StartTime,soFromBeginning);
MyMemFile.CopyFrom(MyMpegFile,MyTimeFramSize*TimeLength);
MyMemFile.SaveToFile(DestFile);
finally
MyMemFile.Free;
MyMpegFile.Free;
end;
except
Result:=False;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
iVcdTime:=0;
end;
procedure TForm1.Bt_OpenClick(Sender: TObject);
var
MyFileSize:Longint;
iTime:integer;
begin
if OpenDialog1.Execute then
begin
Label_Filename.Caption:=OpenDialog1.FileName;
MyFileSize:=GetFileSize(OpenDialog1.FileName);
iTime:=Trunc((MyFileSize-(GetPacketHead(Label_Filename.Caption)))/(75*2352));
iVcdTime:=iTime;
Label_FileSize.Caption:='文件大小:'+IntToStr(MyFileSize)+'字节';
Label_VcdTime.Caption:='估计总长度:'+IntToStr(iTime)+'秒钟';
Edit_End.Text:=IntToStr(iTime);
end;
end;
procedure TForm1.Bt_SaveClick(Sender: TObject);
begin
if SaveDialog1.Execute then Edit_Save1.Text:=SaveDialog1.FileName;
end;
procedure TForm1.Bt_CutClick(Sender: TObject);
var
iStart,iEnd,Code:integer;
begin
if Not FileExists(Label_Filename.Caption) then
begin
Application.MessageBox('源文件不存在,请重新选择!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if Edit_Save1.Text='' then
begin
Application.MessageBox('请先选择目标文件名称!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if FileExists(Edit_Save1.Text) then
if(Application.MessageBox('目标文件已经存在,您要覆盖它吗?', Pchar(Application.Title), MB_YESNO +MB_ICONQUESTION) = IDNO)
then Exit;
Val(Edit_Start.Text,iStart,Code);
if Code<>0 then
begin
Application.MessageBox('开始时间必须为整数,请重新输入!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
Val(Edit_End.Text,iEnd,Code);
if Code<>0 then
begin
Application.MessageBox('时间长度必须为整数,请重新输入!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if iStart<0 then
begin
Application.MessageBox('开始时间必须为正整数,请重新输入!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if iStart>=iVcdTime then
begin
Application.MessageBox('开始时间不能大于或等于文件总长度,请重新输入!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if iEnd>iVcdTime then
begin
Application.MessageBox('时间长度不能大于文件总长度,请重新输入!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if iEnd<=0 then
begin
Application.MessageBox('时间长度必须大于0,请重新输入!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
if ((iStart-iEnd)>=iVcdTime) or ((iEnd-iStart)>=iVcdTime) or(((iEnd+iStart)>iVcdTime)) then
begin
Application.MessageBox('实际时间不能大于或等于文件总长度,请重新输入!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
Exit;
end;
My_CutMpegFile(Label_Filename.Caption,Edit_Save1.Text,iStart,iEnd);
Application.MessageBox('切割完毕!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
end;
end.
可能大家还记得我曾经写过一篇<<用Delphi在局域网中实现网上影院>>,就是在局部网内一台电脑播放视频文件整个局部网的电脑都可以收到.那个采用的是隐形动态共享的办法.但是那个方法有个致命的弱点,就是当播放的是光盘文件而不是磁盘文件的时候,当几个人同时访问光驱就不行了.所以那个是取巧的方法.真正的方法是采用流.或者在数据头伪造Mediaplay Server服务器.这样一来无论是磁盘文件还是光盘文件,实际上都是服务器一台电脑读数据而已,就不会发生上面的情况了.具体程序可以在我的主页http://www.138soft.com下载.但是如果对这些不熟练怎么办?哈哈,你还是可以采用取巧的方法:服务端开两个线程,一个发送文件头,另外一个发送数据.客户端也开两个线程,一个接收数据保存为文件,另外一个播放.比如说每个文件为4MB,接收完第一个后开始播放同时继续接收第二个.播放完第一个就删除并播放第二个文件.实际上,早期的DVB就是这样做的.
三:图标文件ICO格式程序编程
Windows下的可执行文件大多都有一个图标的.如果这个程序是你自己编写的,那么你可以轻松的在编译为EXE之前把图标更换掉.但是如果这个EXE不是你的呢?怎么办?当然是用工具了.ResHacker(资源黑客)就是一个很好的工具.但是如果想自己编写程序来实现呢?
图标在可执行文件里面实际上是一项资源.Windows提供了一个API函数来取出EXE里面的图标.函数原型为:HICON ExtractIcon(HINSTANCE hInst,LPCTSTR lpszExeFileName,UINT nIconIndex);其中第一个参数为实例句柄,第二个参数为需要操作的EXE,DLL,BMP或ICON等包含有图标资源的文件名,第三个参数为需要取出的图标在该EXE里面的索引(因为一个EXE文件里面可能含有多个图标).如果这个参数为0,那么将返回第一个图标,如果这个参数为-1,将返回该文件可能含有的所有图标数.如果该文件含有该索引图标,函数将返回该图标的句柄,否则返回值NULL.
那么,到底我们应该怎么样才能更换一个EXE的图标呢?如果你熟悉PE文件结构的话就很简单了.不过PE文件格式是比较复杂的,讲述它的话要费很大篇幅.实际上,你可以这样简单的看一个EXE文件的组成:EXE文件=文件头之类+图标资源+文件尾.也就是说,你不用管它的文件头和文件尾之类,只要找到图标在该EXE里面的位置,然后用你的图标覆盖它即可.
不过需要注意的是,图标是有多种格式的,比如说16X16的16色,32X32的16色,16X16的32色等等.用这种方法更换图标的话必须注意格式要一致.另外,ExtractIcon函数返回的将是32X32的16色图标.这是个很有趣的地方.也就是说,无论你操作的文件或图标格式是怎么样,它取出的都是32X32的16色图标.而Delphi默认的那个图标就是这个格式的.
我们打开Delphi,新建一个工程.直接编译后退出.这个得到的EXE我们将用来做"实验品".再新建一个工程,这个才是我们真正要写的程序.往窗口添加两个名字分别为Next_Icon, Prev_Icon的TSpeedButton.作用是枚举图标的.添加一个Image1用来显示图标.一个名为Edit_SourceFile的TEdit用来显示选择要取出的EXE之类的文件名称.一个OpenDialog,一个SaveDialog和三个Button.最后记得在Use部分添加ShellApi.全部代码如下:
unit Unit1;
interface
uses
ShellApi{必须添加此单元}, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Buttons;
type
TForm1 = class(TForm)
Next_Icon: TSpeedButton;
Prev_Icon: TSpeedButton;
Image1: TImage;
Edit_SourceFile: TEdit;
Button1: TButton;
Button2: TButton;
Button3: TButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
procedure Button1Click(Sender: TObject);
procedure Prev_IconClick(Sender: TObject);
procedure Next_IconClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure Extract_Icon;
function ChangeExeIcon(ExeFile,IconFile:string;Index:Integer=0):Boolean;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Icon_Index: integer;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Caption:='取出图标';
Button2.Caption:='保存图标';
Button3.Caption:='更换图标';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
OpenDialog1.Filter := '所有支持类型(*.EXE,*.DLL,*.OCX,*.ICL,*.ICO,*.BMP)|*.exe;*.dll;*.ocx;*.icl;*.ico;*.bmp|所有文件 (*.*)|*.*';
if OpenDialog1.Execute
then
begin
Edit_SourceFile.Text := OpenDialog1.Filename;
Icon_Index := 0;
Extract_Icon;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
SaveDialog1.Filter :='图标文件(*.ICO)|*.ico';
if SaveDialog1.Execute then
begin
if Copy(SaveDialog1.FileName, Length(SaveDialog1.FileName)-3, 1) = '.' then
Image1.Picture.Icon.SaveToFile(SaveDialog1.FileName)
else
Image1.Picture.Icon.SaveToFile(SaveDialog1.FileName + '.ico');
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
ExeFile:String;
begin
OpenDialog1.Filter := 'EXE文件(*.EXE)|*.exe';
OpenDialog1.Title:='请选择需要更换图标的EXE';
if OpenDialog1.Execute then
begin
ExeFile:=OpenDialog1.FileName;
OpenDialog1.Filter := '图标文件(*.ICO)|*.ico';
OpenDialog1.Title:='请选择需要更换的图标文件';
OpenDialog1.FileName:='';{Clear the Old Filename}
if OpenDialog1.Execute then
if ChangeExeIcon(ExeFile,OpenDialog1.FileName) then
Application.MessageBox('更换图标成功!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK)
else
Application.MessageBox('更换图标失败!',Pchar(Application.Title),MB_ICONERROR+MB_OK)
else
Exit; {Not Select Icon File}
end;
end;
procedure TForm1.Prev_IconClick(Sender: TObject); //枚举前一个图标
begin
if not (FileExists(Edit_SourceFile.Text)) or (Icon_Index <= 0) then Exit;
Icon_Index := Icon_Index - 1;
Extract_Icon;
end;
procedure TForm1.Next_IconClick(Sender: TObject);//枚举下一个图标
begin
if not (FileExists(Edit_SourceFile.Text)) then Exit;
Icon_Index := Icon_Index + 1;
Extract_Icon;
end;
procedure TForm1.Extract_Icon;
var
icon_handle: Longint;
buffer: array[0..1024] of Char;
begin
if not (FileExists(Edit_SourceFile.Text)) then Exit;
StrPCopy(Buffer, Edit_SourceFile.Text);
icon_handle := ExtractIcon(self.Handle, buffer, icon_index);
if Icon_Handle = 0 {Did we get a valid handle back?}
then
begin {No}
if Icon_Index = 0 {Is this the first icon in the file?}
then {Yes. There can't be any icons in this file}
begin
Application.MessageBox('这个文件没有发现图标,请重新选择!','信息',MB_ICONINFORMATION+MB_OK);
Image1.Visible := False;
end
else {No. We must have gone beyond the limit. Step back}
Icon_Index := Icon_Index - 1;
Exit;
end;
{We now have our extracted icon. Save it to a temp file in readiness for the modifocation}
Image1.Picture.Icon.Handle := icon_handle;
Image1.Visible := True;
end;
function TForm1.ChangeExeIcon(ExeFile,IconFile:string;Index:Integer=0):Boolean;
var
TempStream,NewIconMemoryStream:TMemoryStream;
OldIconStrings,ExeStrings,ExeIconStrings:TStringStream;
ExeIcon:TIcon;
IconPosition,IconLength,IconHeadLength:Integer;
IconHandle:HICON;
ExeFileStream,IconFileStream:TFileStream;
begin
Result:=False;
IconHeadLength:=126;
if (not FileExists(ExeFile)) or (not FileExists(IconFile)) then Exit;
try
ExeFileStream:=TFileStream.Create(ExeFile,fmOpenReadWrite+fmShareDenyWrite);
ExeStrings:=TStringStream.Create('');
ExeStrings.Position:=0;
ExeFileStream.Position:=0;
ExeStrings.CopyFrom(ExeFileStream,0);
ExeIcon:=TIcon.Create;
IconHandle:=ExtractIcon(Application.Handle,Pchar(ExeFile),Index);
if IconHandle<=1 then
begin
Application.MessageBox('EXE中没有找到该序列的图标!',Pchar(Application.Title),MB_ICONERROR+MB_OK);
Exit;
end;
ExeIcon.Handle:=IconHandle;
ExeIconStrings:=TStringStream.Create('');
ExeIcon.SaveToStream(ExeIconStrings);
ExeIcon.Free;
ExeIcon:=nil;
IconLength:=ExeIconStrings.Size-IconHeadLength;
ExeIconStrings.Position:=IconHeadLength;
OldIconStrings:=TStringStream.Create('');
OldIconStrings.Position:=0;
ExeIconStrings.Position:=IconHeadLength;
OldIconStrings.CopyFrom(ExeIconStrings,IconLength);
ExeIconStrings.Free;
IconPosition:=Pos(OldIconStrings.DataString,ExeStrings.DataString);
ExeStrings.Free;
ExeStrings:=nil;
OldIconStrings.Free;
IconFileStream:=TFileStream.Create(IconFile,fmOpenRead+fmShareDenyNone);
NewIconMemoryStream:=TMemoryStream.Create;
IconFileStream.Position:=IconHeadLength;
NewIconMemoryStream.Position:=0;
NewIconMemoryStream.CopyFrom(IconFileStream,IconFileStream.Size-IconHeadLength);
IconFileStream.Free;
if IconPosition<=0 then
begin
Application.MessageBox('EXE中没有找到该图标的数据!',Pchar(Application.Title),MB_ICONERROR+MB_OK);
Exit;
end;
if IconLength<>NewIconMemoryStream.Size then
begin
TempStream:=TMemoryStream.Create;
ExeFileStream.Position:=IconPosition+IconLength-1;
TempStream.Position:=0;
TempStream.CopyFrom(ExeFileStream,ExeFileStream.Size-ExeFileStream.Position);
ExeFileStream.Position:=IconPosition-1;
NewIconMemoryStream.Position:=0;
ExeFileStream.CopyFrom(NewIconMemoryStream,0);
TempStream.Position:=0;
ExeFileStream.CopyFrom(TempStream,0);
ExeFileStream.Position:=0;
ExeFileStream.Size:=IconPosition+IconLength-1+TempStream.Size;
TempStream.Free;
end
else
begin
ExeFileStream.Position:=IconPosition-1;
NewIconMemoryStream.Position:=0;
ExeFileStream.CopyFrom(NewIconMemoryStream,0);
end;
NewIconMemoryStream.Free;
Result:=True;
finally
ExeFileStream.Free;
end;
end;
end.
运行程序,点"取出图标",选择一个EXE,然后点"保存图标"将其ICO保存为文件.然后点"更换图标",选择我们刚才编译得到的"实验品"和取出的图标,即可将图标更改掉了.
自定义函数ChangeExeIcon的实现过程如下:先用ExtractIcon将图标释放出来保存为文件,然后将其与EXE比较在该EXE里面找到图标的位置,然后将新图标的内容覆盖原来的图标.实际上,这个查找过程还不够完美,因为它将两者都转化为TStringStream再比较,如果EXE文件很大的话是很费内存的.Delphi本身提供了一个例子用来查找位置的,该例子位于Delphi5/Demos/Resxplor下,读者可以结合它来作出高效的图标更换工具.
★作者:
陈经韬
430074湖北省武汉市武昌民院路湖北经济管理大学计算机系(本)9801班
Home:http://lovejintao.126.com
E-Mail: Lovejingtao@21cn.com
&copy;CopyRight 2000-2003