Res : TResourceStream;
begin
try
Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
try
Res.SavetoFile(ResNewName);
Result:=true;
finally
Res.Free;
end;
except
Result:=false;
end;
end;
Function TForm1.Cjt_AddtoFile(SourceFile,TargetFile:string):Boolean;
var
Target,Source:TFileStream;
MyFileSize:integer;
begin
try
Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareExclusive);
Target:=TFileStream.Create(TargetFile,fmOpenWrite or fmShareExclusive);
try
Target.Seek(0,soFromEnd);//往尾部添加资源
Target.CopyFrom(Source,0);
MyFileSize:=Source.Size+Sizeof(MyFileSize);//计算资源大小，并写入辅程尾部
Target.WriteBuffer(MyFileSize,sizeof(MyFileSize));
finally
Target.Free;
Source.Free;
end;
except
Result:=False;
Exit;
end;
Result:=True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Caption:=''''Bmp2Exe演示程序.作者:陈经韬'''';
Edit1.Text:='''''''';
OpenPictureDialog1.DefaultExt := GraphicExtension(TBitmap);
OpenPictureDialog1.Filter := GraphicFilter(TBitmap);
Button1.Caption:=''''选择BMP图片'''';
Button2.Caption:=''''生成EXE'''';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
Edit1.Text:=OpenPictureDialog1.FileName;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
HeadTemp:String;
begin
if Not FileExists(Edit1.Text) then
begin
Application.MessageBox(''''BMP图片文件不存在，请重新选择!'''',''''信息'''',MB_ICONINFORMATION+MB_OK)
Exit;
end;
HeadTemp:=ChangeFileExt(Edit1.Text,''''.exe'''');
if ExtractRes(''''exefile'''',''''head'''',HeadTemp) then
if Cjt_AddtoFile(Edit1.Text,HeadTemp) then
Application.MessageBox(''''EXE文件生成成功!'''',''''信息'''',MB_ICONINFORMATION+MB_OK)
else
begin
if FileExists(HeadTemp) then DeleteFile(HeadTemp);
Application.MessageBox(''''EXE文件生成失败!'''',''''信息'''',MB_ICONINFORMATION+MB_OK)
end;
end;
end.
怎么样？很神奇吧:)把程序界面弄的漂亮点，再添加一些功能，你会发现比起那些要注册的软件来也不会逊多少吧。
-----------------------------------------------------------------------
实际应用之三：利用流制作自己的OICQ
OICQ是深圳腾讯公司的一个网络实时通讯软件，在国内拥有大量的用户群。但OICQ必须连接上互联网登陆到腾讯的服务器才能使用。所以我们可以自己写一个在局部网里面使用。
OICQ使用的是UDP协议，这是一种无连接协议，即通信双方不用建立连接就可以发送信息，所以效率比较高。Delphi本身自带的FastNEt公司的NMUDP控件就是一个UDP协议的用户数据报控件。不过要注意的是如果你使用了这个控件必须退出程序才能关闭计算机，因为TNMXXX控件有BUG。所有nm控件的基础 PowerSocket用到的ThreadTimer，用到一个隐藏的窗口（类为TmrWindowClass）处理有硬伤。
出问题的地方：
Psock::TThreadTimer::WndProc(var msg:TMessage)
if msg.message=WM_TIMER then
他自己处理
msg.result:=0
else
msg.result:=DefWindowProc(0,....)
end
问题就出在调用 DefWindowProc时，传输的HWND参数居然是常数0，这样实际上DefWindowProc是不能工作的，对任何输入的消息的调用均返回0，包括WM_QUERYENDSESSION，所以不能退出windows。由于DefWindowProc的不正常调用，实际上除WM_TIMER，其他消息由DefWindowProc处理都是无效的。
解决的办法是在 PSock.pas
在 TThreadTimer.Wndproc 内
Result := DefWindowProc( 0, Msg, WPARAM, LPARAM );
改为：
Result := DefWindowProc( FWindowHandle, Msg, WPARAM, LPARAM );
早期低版本的OICQ也有这个问题，如果不关闭OICQ的话，关闭计算机时屏幕闪了一下又返回了。
好了，废话少说，让我们编写我们的OICQ吧,这个实际上是Delphi自带的例子而已:)
新建一个工程，在FASTNET面版拖一个NMUDP控件到窗口，然后依次放上三个EDIT,名字分别为EditIP、EditPort、EditMyTxt，三个按钮BtSend、BtClear、BtSave，一个MEMOMemoReceive，一个SaveDialog和一个状态条StatusBar1。当用户点击BtSend时，建立一个内存流对象，把要发送的文字信息写进内存流，然后NMUDP把流发送出去。当NMUDP有数据接收时，触发它的DataReceived事件，我们在这里再把接收到的流转换为字符信息，然后显示出来。
注意：所有的流对象建立后使用完毕后要记得释放(Free)，其实它的释构函数应该为Destroy，但如果建立流失败的话，用Destroy会产生异常，而用Free的话程序会先检查有没有成功建立了流，如果建立了才释放，所以用Free比较安全。
在这个程序中我们用到了NMUDP控件，它有几个重要的属性。RemoteHost表示远程电脑的IP或者计算机名，LocalPort是本地端口，主要监听有没有数据传入。而RemotePort是远程端口，发送数据时通过这个端口把数据发送出去。理解这些已经可以看懂我们的程序了。
全部代码如下：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, ComCtrls,NMUDP;
type
TForm1 = class(TForm)
NMUDP1: TNMUDP;
EditIP: TEdit;
EditPort: TEdit;
EditMyTxt: TEdit;
MemoReceive: TMemo;
BtSend: TButton;
BtClear: TButton;
BtSave: TButton;
StatusBar1: TStatusBar;
SaveDialog1: TSaveDialog;
procedure BtSendClick(Sender: TObject);
procedure NMUDP1DataReceived(Sender: TComponent; NumberBytes: Integer;
FromIP: String; Port: Integer);
procedure NMUDP1InvalidHost(var handled: Boolean);
procedure NMUDP1DataSend(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BtClearClick(Sender: TObject);
procedure BtSaveClick(Sender: TObject);
procedure EditMyTxtKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.BtSendClick(Sender: TObject);
var
MyStream: TMemoryStream;
MySendTxt: String;
Iport,icode:integer;
Begin
Val(EditPort.Text,Iport,icode);
if icode<>0 then
begin
Application.MessageBox(''''端口必须为数字，请重新输入!'''',''''信息'''',MB_ICONINFORMATION+MB_OK);
Exit;
end;
NMUDP1.RemoteHost := EditIP.Text; {远程主机}
NMUDP1.LocalPort:=Iport; {本地端口}
NMUDP1.RemotePort := Iport; {远程端口}
MySendTxt := EditMyTxt.Text;
MyStream := TMemoryStream.Create; {建立流}
try
MyStream.Write(MySendTxt[1], Length(EditMyTxt.Text));{写数据}
NMUDP1.SendStream(MyStream); {发送流}
finally
MyStream.Free; {释放流}
end;
end;
procedure TForm1.NMUDP1DataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
var
MyStream: TMemoryStream;
MyReciveTxt: String;
begin
MyStream := TMemoryStream.Create; {建立流}
try
NMUDP1.ReadStream(MyStream);{接收流}
SetLength(MyReciveTxt,NumberBytes);{NumberBytes为接收到的字节数}
MyStream.Read(MyReciveTxt[1],NumberBytes);{读数据}
MemoReceive.Lines.Add(''''接收到来自主机''''+FromIP+''''的信息:''''+MyReciveTxt);
finally
MyStream.Free; {释放流}
end;
end;
procedure TForm1.NMUDP1InvalidHost(var handled: Boolean);
begin
Application.MessageBox(''''对方IP地址不正确，请重新输入!'''',''''信息'''',MB_ICONINFORMATION+MB_OK);
end;
procedure TForm1.NMUDP1DataSend(Sender: TObject);
begin
StatusBar1.SimpleText:=''''信息成功发出!'''';
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
EditIP.Text:=''''127.0.0.1'''';
EditPort.Text:=''''8868'''';
BtSend.Caption:=''''发送'''';
BtClear.Caption:=''''清除聊天记录'''';
BtSave.Caption:=''''保存聊天记录'''';
MemoReceive.ScrollBars:=ssBoth;
MemoReceive.Clear;
EditMyTxt.Text:=''''在这里输入信息,然后点击发送.'''';
StatusBar1.SimplePanel:=true;
end;
procedure TForm1.BtClearClick(Sender: TObject);
begin
MemoReceive.Clear;
end;
procedure TForm1.BtSaveClick(Sender: TObject);
begin
if SaveDialog1.Execute then MemoReceive.Lines.SaveToFile(SaveDialog1.FileName);
end;
procedure TForm1.EditMyTxtKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then BtSend.Click;
end;
end.
上面的程序跟OICQ相比当然差之甚远，因为OICQ利用的是Socket5通信方式。它上线时先从服务器取回好友信息和在线状态，发送超时还会将信息先保存在服务器，等对方下次上线后再发送然后把服务器的备份删除。你可以根据前面学的概念来完善这个程序，比如说再添加一个NMUDP控件来管理在线状态，发送的信息先转换成ASCII码进行与或运行并加上一个头信息，接收方接收信息后先判断信息头正确与否，如果正确才把信息解密显示出来，这样就提高了安全保密性。
另外，UDP协议还有一个很大的好处就是可以广播，就是说处于一个网段的都可以接收到信息而不必指定具体的IP地址。网段一般分A、B、C三类,
1~126.XXX.XXX.XXX (A类网) :广播地址为XXX.255.255.255
128~191.XXX.XXX.XXX(B类网):广播地址为XXX.XXX.255.255
192~254.XXX.XXX.XXX(C类网):广播地址为XXX.XXX.XXX.255
比如说三台计算机192.168.0.1、192.168.0.10、192.168.0.18，发送信息时只要指定IP地址为192.168.0.255就可以实现广播了。下面给出一个转换IP为广播IP的函数，快拿去完善自己的OICQ吧^-^.
Function Trun_ip(S:string):string;
var s1,s2,s3,ss,sss,Head:string;
n,m:integer;
begin
sss:=S;
n:=pos(''''.'''',s);
s1:=copy(s,1,n);
m:=length(s1);
delete(s,1,m);
Head:=copy(s1,1,(length(s1)-1));
n:=pos(''''.'''',s);
s2:=copy(s,1,n);
m:=length(s2);
delete(s,1,m);
n:=pos(''''.'''',s);
s3:=copy(s,1,n);
m:=length(s3);
delete(s,1,m);
ss:=sss;
if strtoint(Head) in [1..126] then ss:=s1+''''255.255.255''''; //1~126.255.255.255 (A类网)
if strtoint(Head) in [128..191] then ss:=s1+s2+''''255.255'''';//128~191.XXX.255.255(B类网)
if strtoint(Head) in [192..254] then ss:=s1+s2+s3+''''255''''; //192~254.XXX.XXX.255(C类网)
Result:=ss;
end;
-----------------------------------------------------------------------
五、实际应用之四：利用流实现网络传输屏幕图像
大家应该见过很多网管程序，这类程序其中有一个功能就是监控远程电脑的屏幕。实际上，这也是利用流操作来实现的。下面我们给出一个例子，这个例子分两个程序，一个服务端，一个是客户端。程序编译后可以直接在单机、局部网或者互联网上使用。程序中已经给出相应注释。后面我们再来作具体分析。
新建一个工程，在Internet面版上拖一个ServerSocket控件到窗口，该控件主要用于监听客户端，用来与客户端建立连接和通讯。设置好监听端口后调用方法Open或者Active:=True即开始工作。注意：跟前面的NMUDP不同，当Socket开始监听后就不能再改变它的端口，要改变的话必须先调用Close或设置Active为False，否则将会产生异常。另外，如果该端口已经打开的话，就不能再用这个端口了。所以程序运行尚未退出就不能再运行这个程序，否则也会产生异常，即弹出出错窗口。实际应用中可以通过判断程序是否已经运行，如果已经运行就退出的方法来避免出错。
当客户端有数据传入，将触发ServerSocket1ClientRead事件，我们可以在这里对接收的数据进行处理。在本程序中，主要是接收客户端发送过来的字符信息并根据事先的约定来进行相应操作。
程序全部代码如下：
unit Unit1;{服务端程序}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, JPEG,ExtCtrls, ScktComp;
type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
procedure ServerSocket1ClientRead(Sender: TObject;Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
procedure Cjt_GetScreen(var Mybmp: TBitmap; DrawCur: Boolean);
{自定义抓屏函数,DrawCur表示抓鼠标图像与否}
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
MyStream: TMemorystream;{内存流对象}
impl上一页 [1] [2] [3] 下一页 |
