http://www.cnblogs.com/lovejsw2000/archive/2008/11/7.html
在Delphi中静态调用DLL top
调用一个DLL比写一个DLL要容易一些。首先给大家介绍的是静态调用方法，稍后将介绍动态调用方法，并就两种方法做一个比较。同样的，我们先举一个静态调用的例子。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
//本行以下代码为我们真正动手写的代码
function TestDll(i:integer):integer;stdcall;
external ’Delphi.dll’;
procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text:=IntToStr(TestDll(1));
end;
end.
上面的例子中我们在窗体上放置了一个编辑框（Edit）和一个按钮（Button），并且书写了很少的代码来测试我们刚刚编写的Delphi.dll。大家可以看到我们唯一做的工作是将TestDll函数的说明部分放在了implementation中，并且用external语句指定了Delphi.dll的位置。（本例中调用程序和Delphi.dll在同一个目录中。）让人兴奋的是，我们自己编写的TestDll函数很快被Delphi认出来了。您可做这样一个实验：输入“TestDll（”，很快Delphi就会用fly-by提示条提示您应该输入的参数是什么，就像我们使用Delphi中定义的其他函数一样简单。注意事项有以下一些：
一、调用参数用stdcall
和前面提到的一样，当引用DLL中的函数和过程时也要使用stdcall参数，原因和前面提到的一样。
二、用external语句指定被调用的DLL文件的路径和名称
正如大家看到的，我们在external语句中指定了所要调用的DLL文件的名称。没有写路径是因为该DLL文件和调用它的主程序在同一目录下。如果该DLL文件在C:，则我们可将上面的引用语句写为external ’C:Delphi.dll’。注意文件的后缀.dll必须写上。
三、不能从DLL中调用全局变量
如果我们在DLL中声明了某种全局变量，如：var s:byte 。这样在DLL中s这个全局变量是可以正常使用的，但s不能被调用程序使用，既s不能作为全局变量传递给调用程序。不过在调用程序中声明的变量可以作为参数传递给DLL。
四、被调用的DLL必须存在
这一点很重要，使用静态调用方法时要求所调用的DLL文件以及要调用的函数或过程等等必须存在。如果不存在或指定的路径和文件名不正确的话，运行主程序时系统会提示“启动程序时出错”或“找不到*.dll文件”等运行错误。
在Delphi中动态调用DLL top
动态调用DLL相对复杂很多，但非常灵活。为了全面的说明该问题，这次我们举一个调用由C++编写的DLL的例子。首先在C++中编译下面的DLL源程序。
#include
extern ”C” _declspec(dllexport)
int WINAPI TestC(int i)
{
return i;
}
编译后生成一个DLL文件，在这里我们称该文件为Cpp.dll，该DLL中只有一个返回整数类型的函数TestC。为了方便说明，我们仍然引用上面的调用程序，只是将原来的Button1Click过程中的语句用下面的代码替换掉了。
procedure TForm1.Button1Click(Sender: TObject);
type
TIntFunc=function(i:integer):integer;stdcall;
var
Th:Thandle;
Tf:TIntFunc;
Tp:TFarProc;
begin
Th:=LoadLibrary(’Cpp.dll’); {装载DLL}
if Th>0 then
try
Tp:=GetProcAddress(Th,PChar(’TestC’));
if Tp<>nil
then begin
Tf:=TIntFunc(Tp);
Edit1.Text:=IntToStr(Tf(1)); {调用TestC函数}
end
else
ShowMessage(’TestC函数没有找到’);
finally
FreeLibrary(Th); {释放DLL}
end
else
ShowMessage(’Cpp.dll没有找到’);
end;
大家已经看到了，这种动态调用技术很复杂，但只要修改参数，如修改LoadLibrary(’Cpp.dll’)中的DLL名称为’Delphi.dll’就可动态更改所调用的DLL。
一、定义所要调用的函数或过程的类型
在上面的代码中我们定义了一个TIntFunc类型，这是对应我们将要调用的函数TestC的。在其他调用情况下也要做同样的定义工作。并且也要加上stdcall调用参数。
二、释放所调用的DLL
我们用LoadLibrary动态的调用了一个DLL，但要记住必须在使用完后手动地用FreeLibrary将该DLL释放掉，否则该DLL将一直占用内存直到您退出Windows或关机为止。
现在我们来评价一下两种调用DLL的方法的优缺点。静态方法实现简单，易于掌握并且一般来说稍微快一点，也更加安全可靠一些；但是静态方法不能灵活地在运行时装卸所需的DLL，而是在主程序开始运行时就装载指定的DLL直到程序结束时才释放该DLL，另外只有基于编译器和链接器的系统（如Delphi）才可以使用该方法。动态方法较好地解决了静态方法中存在的不足，可以方便地访问DLL中的函数和过程，甚至一些老版本DLL中新添加的函数或过程；但动态方法难以完全掌握，使用时因为不同的函数或过程要定义很多很复杂的类型和调用方法。对于初学者，笔者建议您使用静态方法，待熟练后再使用动态调用方法。
使用DLL的实用技巧 top
一、编写技巧
1 、为了保证DLL的正确性，可先编写成普通的应用程序的一部分，调试无误后再从主程序中分离出来，编译成DLL。
2 、为了保证DLL的通用性，应该在自己编写的DLL中杜绝出现可视化控件的名称，如：Edit1.Text中的Edit1名称；或者自定义非Windows定义的类型，如某种记录。
3 、为便于调试，每个函数和过程应该尽可能短小精悍，并配合具体详细的注释。
4 、应多利用try-finally来处理可能出现的错误和异常，注意这时要引用SysUtils单元。
5 、尽可能少引用单元以减小DLL的大小，特别是不要引用可视化单元，如Dialogs单元。例如一般情况下，我们可以不引用Classes单元，这样可使编译后的DLL减小大约16Kb。
二、调用技巧
1 、在用静态方法时，可以给被调用的函数或过程更名。在前面提到的C++编写的DLL例子中，如果去掉extern ”C”语句，C++会编译出一些奇怪的函数名，原来的TestC函数会被命名为@TestC$s等等可笑的怪名字，这是由于C++采用了C++ name mangling技术。这个函数名在Delphi中是非法的，我们可以这样解决这个问题：
改写引用函数为
function TestC(i:integer):integer;stdcall;
external ’Cpp.dll’;name ’@TestC$s’;
其中name的作用就是重命名。
2 、可把我们编写的DLL放到Windows目录下或者Windowssystem目录下。这样做可以在external语句中或LoadLibrary语句中不写路径而只写DLL的名称。但这样做有些不妥，这两个目录下有大量重要的系统DLL，如果您编的DLL与它们重名的话其后果简直不堪设想，况且您的编程技术还不至于达到将自己编写的DLL放到系统目录中的地步吧！
三、调试技巧
1 、我们知道DLL在编写时是不能运行和单步调试的。有一个办法可以，那就是在Run|parameters菜单中设置一个宿主程序。在Local页的Host Application栏中添上宿主程序的名字就可进行单步调试、断点观察和运行了。
2 、添加DLL的版本信息。开场白中提到了版本信息对于DLL是很重要的，如果包含了版本信息，DLL的大小会增加2Kb。增加这么一点空间是值得的。很不幸我们如果直接使用Project|options菜单中Version选项是不行的，这一点Delphi的帮助文件中没有提到，经笔者研究发现，只要加一行代码就可以了。如下例：
library Delphi;
uses
SysUtils,
Classes;
{$R *.RES}
//注意，上面这行代码必须加在这个位置
function TestDll(i:integer):integer;stdcall;
begin
Result:=i;
end;
exports
TestDll;
begin
end.=
3 、为了避免与别的DLL重名，在给自己编写的DLL起名字的时候最好采用字符数字和下划线混合的方式。如：jl_try16.dll。
4 、如果您原来在Delphi 1或Delphi 2中已经编译了某些DLL的话，您原来编译的DLL是16位的。只要将源代码在新的Delphi 3或Delphi 4环境下重新编译，就可以得到32位的DLL了。
posted @
2008-11-07 16:22 YangHe 阅读(17) |
评论 (0) |
编辑
1引言
Windows Sockets规范以U.C. Berkeley大学BSD UNIX中流行的Socket接口为范例定义了一套Microsoft Windows下网络编程接口。它不仅包含了人们所熟悉的Berkeley Socket风格的库函数；也包含了一组针对Windows的扩展库函数，以使程序员能充分地利用Windows消息驱动机制进行编程。
Windows Sockets 规范本意在于提供给应用程序开发者一套简单的API，并让各家网络软件供应商共同遵守。此外，在一个特定版本Windows的基础上，Windows Sockets 也定义了一个二进制接口(ABI)，以此来保证应用Windows Sockets API 的应用程序能够在任何网络软件供应商的符合Windows Sockets协议的实现上工作。因此这份规范定义了应用程序开发者能够使用，并且网络软件供应商能够实现的一套库函数调用和相关语义。我们可以使用WinSock在Internet上传输数据和交换信息，而且可以不需要关心网络连接的细节,因而很受网络编程程序员的欢迎。
2 Delphi中Socket的操作方式
Delphi分别使用TClientSocket元件和TServerSocket元件来操纵客户端 Socket和服务器段Socket的连接和通信。根据连接发起的方式以及本地 Socket要连接的目标，Socket之间的连接可以分为：客户端连接、监听连接以及服务器端连接。
(1)所谓客户端连接，是指由客户端的 Socket提出连接请求，要连接的目标是服务器端的Socket。为此，客户端的Socket首先要描述它要连接的服务器端Socket，主要是服务器端Socket的地址和端口号，然后再定位所要连接的服务器端Socket。找到以后，就向服务器端Socket请求连接。此时，服务器端的Socket未必正好处于准备好状态。不过，服务器端Socket会自动维护一个客户请求队列,通过这个队列的优先顺序,会在适当的时候通过请求响应的方式向客户端Socket发出"允许连接"(Accept)的信号，这样便在客户端和服务器端通过Sockets建立了连接！
(2)所谓监听连接，是指服务器端Socket并不定位具体的客户端Socket，而是处于等待连接状态，当服务器端 Socket监听到或者接收到客户端Socket的连接请求的时候，它就响应客户端Socket的请求建立一个新的Socket句柄并与客户端连接，而服务器端Socket继续处于监听状态，这样可以与多个客户端同时建立连接。
(3)所谓服务器端连接，是指当服务器端Socket接收到客户端Socket的连接请求后，就把服务器端Socket的描述发送给客户端。一旦客户端确认了此描述，就建立了连接！
3 线程控制的提出
一旦服务器与客户端建立了连接之后，就可以通过 Internet 传输数据和文件。但是在WinSock中存在两种传输模式"阻塞"和"非阻塞"的概念。
一般都采用非阻塞方式。在客户端，如果把 ClientType特性设置为ctNonBlocking,表示采用非阻塞方式进行连接。当服务器端 Socket试图进行读/写操作的时候，客户端 Socket就会得到通知，即OnRead或者OnWrite事件。
对于服务器端Socket来说，如果把ServerType特性设置为 StNonBlocking，表示采取非阻塞方式进行连接。当客户端 Socket试图进行读/写的时候，服务器端Socket就会得到通知，即OnClientRead或者OnClientWrite事件。
与非阻塞方式不同的是，在阻塞方式下没有诸如OnRead或者OnWrite等异步事件。Socket必须主动去读或者写数据。在读写操作完成之前，其他代码都无法执行，成为了纯粹的独占使用方式，整个应用程序将处于等待状态，大大降低应用程序的性能。
对于客户端Socket来说，如果把 ClientType特性设置为ctBlocking，表示采取阻塞方式进行连接，为了尽可能的减少阻塞方式的负面影响,可以把所有涉及到读写的操作放在一个单独的线程中，这样可以使其他的线程可以继续得到执行。
对于服务器端 Socket来说，如果把ServerType设置为stThreadBlocking，表示采取阻塞方式进行连接。Delphi 中将为每一个阻塞方式的连接自动分配一个新的线程，这样即使一个客户正在进行读写操作，其他的客户也不必等待。
4 在客户端使用多线程技术
在阻塞模式下，为了尽可能的减少阻塞方式的副作用，可以把所有的涉及到读写操作放在一个单独的线程种。为此，需要创建一个新的线程对象，然后重载它的Execute方法,在线程代码中，我们通过TWinSockStream对象来进行读写操作。
Procedure TClientThread.Execute;
Var sStream: TWinSockStream;
sBuffer: string;
Begin
//建一个TWinSocketStream对象实例，设置连接超时
SSteam: = TWinSockStream.Create (ClientSocket.Socket, 60000);
Try //获取和操作命令,直到连接断开或者线程终止
While (not Terminate) and (ClientSocket.Active) do
begin
try
GetNextRequest (sBuffer);
//将请求写回到Server
sStream.Write (sBuffer, Length (sBuffer) + 1);
…
Except
if not(Except Object is EAbort) then
//处理一些自定义的异常情况
Synchronize(HandleThreadException);
end;
end;
finally
sStream.Free;
end;
End;
5 在服务器端使用多线程技术
在服务器端，Delphi将自动为每一个阻塞方式的连接分配一个新的线程，并通过TServerClientThread来操纵每一个线程。所以不能通过对象库中的向导来创建线程对象，只能手工建立一个TServerClientThread的派生类，然后重载ClientExcute方法。Procedure TServerThread.ClientExcute;
Var sStream:TWinSocketStream;
sBuffer:array[0..9] of char
Begin
//获取和操作命令,直到连接断开或者线程终止
While (not Terminate) and (ClientSocket.Active) do
Begin
Try
sStream:= TWinSocketStream.Create(ClientSocket.Socket,60000);
try //填充SBuffer数组
FillChar(sBuffer,10,0);
//延迟时间60秒
If sStream.WaitForData(60000) then
Begin
If sStream.Read(sBuffer,10)=0 then
ClientSocket.Close;
……
End
Else ClientSocket.Close;
except
HandleException;
end;
Finally
sStream.Free;
end;
end;
End;
总结：通过客户端和服务器端的多线程控制,当我们需要对大信息量的数据处理的时候，尤为方便,而且能够很大程度上提高网络资源的利用率。目前我们正在研究通过线程控制来对数据库的查询进行优化处理以及数据发送问题
posted @
2008-11-07 15:26 YangHe 阅读(51) |
评论 (0) |
编辑
用Delphi编写Socket通信程序
笔者在工作中遇到对局域网中各工作站与服务器之间进行Socket通信的问题。现在将本人总结出来的TServerSocket和TClientSocket两个组件的基本用法写出来，希望与您分享。
ClientSocket组件为客户端组件。它是通信的请求方，也就是说，它是主动地与服务器端建立连接。
ServerSocket组件为服务器端组件。它是通信的响应方，也就是说，它的动作是监听以及被动接受客户端的连接请求，并对请求进行回复。
ServerSocket组件可以同时接受一个或多个ClientSocket组件的连接请求，并与每个ClientSocket组件建立单独的连接，进行单独的通信。因此，一个服务器端可以为多个客户端服务。
设计思路
本例包括一个服务器端程序和一个客户端程序。客户端程序可以放到多个计算机上运行，同时与服务器端进行连接通信。
本例的重点，一是演示客户端与服务器端如何通信；二是当有多个客户端同时连接到服务器端时，服务器端如何识别每个客户端，并对请求给出相应的回复。为了保证一个客户端断开连接时不影响其它客户端与服务器端的通信，同时保证服务器端能够正确回复客户端的请求，在本例中声明了一个记录类型：
type
client_record=record
CHandle: integer; //客户端套接字句柄
CSocket:TCustomWinSocket; //客户端套接字
CName:string; //客户端计算机名称
CAddress:string; //客户端计算机IP地址
CUsed: boolean; //客户端联机标志
end;
利用这个记录类型数据保存客户端的信息，同时保存当前客户端的连接状态。其中，CHandle保存客户端套接字句柄，以便准确定位每个与服务器端保持连接的客户端；Csocket保存客户端套接字，通过它可以对客户端进行回复。Cused记录当前客户端是否与服务器端保持连接。
下面对组件ServerSocket和ClientSocket的属性设置简单说明。
ServerSocket的属性：
· Port，是通信的端口，必须设置。在本例中设置为1025；
· ServerTypt，服务器端读写信息类型，设置为stNonBlocking表示异步读写信息，本例中采用这种方式。
· ThreadCacheSize，客户端的最大连接数，就是服务器端最多允许多少客户端同时连接。本例采用默认值10。
其它属性采用默认设置即可。
ClientSocket的属性：
· Port，是通信的端口，必须与服务器端的设置相同。在本例中设置为1025；
· ClientType，客户端读写信息类型，应该与服务器端的设置相同，为stNonBlocking表示异步读写信息。
· Host，客户端要连接的服务器的IP地址。必须设置，当然也可以在代码中动态设置。
其它属性采用默认设置即可。
程序源代码:
· 服务器端源码（uServerMain.pas）：
unit uServerMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, ToolWin, ComCtrls, ExtCtrls, StdCtrls, Buttons;
const
CMax=10; //客户端最大连接数
type
client_record=record
CHandle: integer; //客户端套接字句柄
CSocket:TCustomWinSocket; //客户端套接字
CName:string; //客户端计算机名称
CAddress:string; //客户端计算机IP地址
CUsed: boolean; //客户端联机标志
end;
type
TfrmServerMain = class(TForm)
ServerSocket: TServerSocket;
ControlBar1: TControlBar;
ToolBar1: TToolBar;
tbConnect: TToolButton;
tbClose: TToolButton;
tbDisconnected: TToolButton;
Edit1: TEdit;
Memo1: TMemo;
StatusBar: TStatusBar;
procedure tbConnectClick(Sender: TObject);
procedure tbDisconnectedClick(Sender: TObject);
procedure ServerSocketClientRead(Sender: TObject;Socket: TCustomWinSocket);
procedure ServerSocketListen(Sender: TObject;Socket: TCustomWinSocket);
procedure ServerSocketClientConnect(Sender: TObject;Socket: TCustomWinSocket);
procedure ServerSocketClientDisconnect(Sender: TObject;Socket: TCustomWinSocket);
procedure tbCloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ServerSocketGetSocket(Sender: TObject; Socket: Integer;
var ClientSocket: TServerClientWinSocket);
procedure ServerSocketClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
private
{
Private declarations
}
public
{
Public declarations
}
session: array[0..CMax] of client_record; //客户端连接数组
Sessions: integer; //客户端连接数
end;
var
frmServerMain: TfrmServerMain;
implementation
{$R *.DFM}
//打开套接字连接，并使套接字进入监听状态
procedure TfrmServerMain.tbConnectClick(Sender: TObject);
begin
ServerSocket.Open ;
end;
//关闭套接字连接，不再监听客户端的请求
procedure TfrmServerMain.tbDisconnectedClick(Sender: TObject);
begin
ServerSocket.Close;
StatusBar.Panels[0].Text :='服务器套接字连接已经关闭，无法接受客户端的连接请求.';
end;
//从客户端读取信息
procedure TfrmServerMain.ServerSocketClientRead(Sender: TObject;Socket: TCustomWinSocket);
var
i:integer;
begin
//将从客户端读取的信息添加到Memo1中
Memo1.Lines.Add(Socket.ReceiveText);
for i:=0 to sessions do
begin
//取得匹配的客户端
if session[i].CHandle = Socket.SocketHandle then
begin
session[i].CSocket.SendText('回复客户端'+session[i].CAddress+' ==> '+Edit1.Text);
end;
end;
end;
//服务器端套接字进入监听状态，以便监听客户端的连接
procedure TfrmServerMain.ServerSocketListen(Sender: TObject;Socket: TCustomWinSocket);
begin
StatusBar.Panels[0].Text :='等待客户端连接...';
end;
//当客户端连接到服务器端以后
procedure TfrmServerMain.ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
var
i,j:integer;
begin
j:=-1;
for i:=0 to sessions do
begin
//在原有的客户端连接数组中有中断的客户端连接
if not session[i].CUsed then
begin
session[i].CHandle := Socket.SocketHandle ;//客户端套接字句柄
session[i].CSocket := Socket; //客户端套接字
session[i].CName := Socket.RemoteHost ; //客户端计算机名称
session[i].CAddress := Socket.RemoteAddress ;//客户端计算机IP
session[i].CUsed := True; //连接数组当前位置已经占用
Break;
end;
j:=i;
end;
if j=sessions then
begin
inc(sessions);
session[j].CHandle := Socket.SocketHandle ;
session[j].CSocket := Socket;
session[j].CName := Socket.RemoteHost ;
session[j].CAddress := Socket.RemoteAddress ;
session[j].CUsed := True;
end;
StatusBar.Panels[0].Text := '客户端 '+Socket.RemoteHost + ' 已经连接';
end;
//当客户端断开连接时
procedure TfrmServerMain.ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
var
i:integer;
begin
for i:=0 to sessions do
begin
if session[i].CHandle =Socket.SocketHandle then
begin
session[i].CHandle :=0;
session[i].CUsed := False;
Break;
end;
end;
StatusBar.Panels[0].Text :='客户端 '+Socket.RemoteHost + ' 已经断开';
end;
//关闭窗口
procedure TfrmServerMain.tbCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmServerMain.FormCreate(Sender: TObject);
begin
sessions := 0;
end;
procedure TfrmServerMain.FormClose(Sender: TObject;var Action: TCloseAction);
begin
ServerSocket.Close ;
end;
//当客户端正在与服务器端连接时
procedure TfrmServerMain.ServerSocketGetSocket(Sender: TObject;
Socket: Integer; var ClientSocket: TServerClientWinSocket);
begin
StatusBar.Panels[0].Text :='客户端正在连接...';
end;
//客户端发生错误
procedure TfrmServerMain.ServerSocketClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
StatusBar.Panels[0].Text :='客户端'+Socket.RemoteHost +'发生错误！';
ErrorCode := 0;
end;
end.
· 客户端源码(uClientMain.pas)：
unit uClientMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, ComCtrls, ToolWin, ExtCtrls, StdCtrls, Buttons;
const
SocketHost = '172.16.1.6'; //服务器端地址
type
TfrmClientMain = class(TForm)
ControlBar1: TControlBar;
ToolBar1: TToolBar;
tbConnected: TToolButton;
tbSend: TToolButton;
tbClose: TToolButton;
tbDisconnected: TToolButton;
ClientSocket: TClientSocket;
Edit1: TEdit;
Memo1: TMemo;
StatusBar: TStatusBar;
btnSend: TBitBtn;
procedure tbConnectedClick(Sender: TObject);
procedure tbDisconnectedClick(Sender: TObject);
procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
procedure tbSendClick(Sender: TObject);
procedure tbCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketConnecting(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmClientMain: TfrmClientMain;
implementation
{$R *.DFM}
//打开套接字连接
procedure TfrmClientMain.tbConnectedClick(Sender: TObject);
begin
ClientSocket.Open ;
end;
//关闭套接字连接
procedure TfrmClientMain.tbDisconnectedClick(Sender: TObject);
begin
ClientSocket.Close;
end;
//接受服务器端的回复
procedure TfrmClientMain.ClientSocketRead(Sender: TObject;Socket: TCustomWinSocket);
begin
Memo1.Lines.Add(Socket.ReceiveText);
end;
//发送信息到服务器端
procedure TfrmClientMain.tbSendClick(Sender: TObject);
begin
ClientSocket.Socket.SendText(Edit1.Text);
end;
procedure TfrmClientMain.tbCloseClick(Sender: TObject);
begin
Close;
end;
//设置要连接的服务器端地址
procedure TfrmClientMain.FormShow(Sender: TObject);
begin
ClientSocket.Host := SocketHost;
end;
//已经连接到服务器端
procedure TfrmClientMain.ClientSocketConnect(Sender: TObject;Socket: TCustomWinSocket);
begin
tbSend.Enabled := True;
tbDisconnected.Enabled :=True;
btnSend.Enabled := True;
StatusBar.Panels[0].Text := '已经连接到 '+ Socket.RemoteHost ;
end;
//正在连接到服务器端
procedure TfrmClientMain.ClientSocketConnecting(Sender: TObject;Socket: TCustomWinSocket);
begin
StatusBar.Panels[0].Text := '正在连接到服务器... ' ;
end;
//当断开与服务器端的连接时发生
procedure TfrmClientMain.ClientSocketDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
tbSend.Enabled := False;
btnSend.Enabled := False;
tbDisconnected.Enabled := False;
StatusBar.Panels[0].Text := '已经断开与 '+ Socket.RemoteHost +' 的连接';
end;
procedure TfrmClientMain.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
ClientSocket.Close ;
end;
//当与服务器端的连接发生错误时
procedure TfrmClientMain.ClientSocketError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;var ErrorCode: Integer);
begin
StatusBar.Panels[0].Text := '与服务器端的连接发生错误';
ErrorCode := 0;
end;
end.
posted @
2008-11-07 15:23 YangHe 阅读(63) |
评论 (0) |
编辑
笔者在工作中遇到对局域网中各工作站与服务器之间进行Socket通信的问题。现在将本人总结出来的TServerSocket和TClientSocket两个组件的基本用法写出来，希望与您分享。
ClientSocket组件为客户端组件。它是通信的请求方，也就是说，它是主动地与服务器端建立连接。
ServerSocket组件为服务器端组件。它是通信的响应方，也就是说，它的动作是监听以及被动接受客户端的连接请求，并对请求进行回复。
ServerSocket组件可以同时接受一个或多个ClientSocket组件的连接请求，并与每个ClientSocket组件建立单独的连接，进行单独的通信。因此，一个服务器端可以为多个客户端服务。
一、设计思路
本例包括一个服务器端程序和一个客户端程序。客户端程序可以放到多个计算机上运行，同时与服务器端进行连接通信。
本例的重点，一是演示客户端与服务器端如何通信；二是当有多个客户端同时连接到服务器端时，服务器端如何识别每个客户端，并对请求给出相应的回复。为了保证一个客户端断开连接时不影响其它客户端与服务器端的通信，同时保证服务器端能够正确回复客户端的请求，在本例中声明了一个记录类型：
type
client_record=record
CHandle: integer; //客户端套接字句柄
CSocket:TCustomWinSocket; //客户端套接字
CName:string; //客户端计算机名称
CAddress:string; //客户端计算机IP地址
CUsed: boolean; //客户端联机标志
end;
利用这个记录类型数据保存客户端的信息，同时保存当前客户端的连接状态。其中，CHandle保存客户端套接字句柄，以便准确定位每个与服务器端保持连接的客户端；Csocket保存客户端套接字，通过它可以对客户端进行回复。Cused记录当前客户端是否与服务器端保持连接
。
二、属性设置
下面对组件ServerSocket和ClientSocket的属性设置简单说明。
１、ServerSocket的属性：
· Port，是通信的端口，必须设置。在本例中设置为1025；
· ServerTypt，服务器端读写信息类型，设置为stNonBlocking表示异步读写信息，本例中采用这种方式。
· ThreadCacheSize，客户端的最大连接数，就是服务器端最多允许多少客户端同时连接。本例采用默认值10。
其它属性采用默认设置即可。
２、ClientSocket的属性：
· Port，是通信的端口，必须与服务器端的设置相同。在本例中设置为1025；
· ClientType，客户端读写信息类型，应该与服务器端的设置相同，为stNonBlocking表示异步读写信息。
· Host，客户端要连接的服务器的IP地址。必须设置，当然也可以在代码中动态设置。
其它属性采用默认设置即可。
三、程序源代码
１、服务器端源码（uServerMain.pas）：
unit uServerMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, ToolWin, ComCtrls, ExtCtrls, StdCtrls, Buttons;
const
CMax=10; //客户端最大连接数
type
client_record=record
CHandle: integer; //客户端套接字句柄
CSocket:TCustomWinSocket; //客户端套接字
CName:string; //客户端计算机名称
CAddress:string; //客户端计算机IP地址
CUsed: boolean; //客户端联机标志
end;
type
TfrmServerMain = class(TForm)
ServerSocket: TServerSocket;
ControlBar1: TControlBar;
ToolBar1: TToolBar;
tbConnect: TToolButton;
tbClose: TToolButton;
tbDisconnected: TToolButton;
Edit1: TEdit;
Memo1: TMemo;
StatusBar: TStatusBar;
procedure tbConnectClick(Sender: TObject);
procedure tbDisconnectedClick(Sender: TObject);
procedure ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketListen(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure tbCloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ServerSocketGetSocket(Sender: TObject; Socket: Integer;
var ClientSocket: TServerClientWinSocket);
procedure ServerSocketClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
private
{ Private declarations }
public
{ Public declarations }
session: array[0..CMax] of client_record; //客户端连接数组
Sessions: integer; //客户端连接数
end;
var
frmServerMain: TfrmServerMain;
implementation
{$R *.DFM}
//打开套接字连接，并使套接字进入监听状态
procedure TfrmServerMain.tbConnectClick(Sender: TObject);
begin
ServerSocket.Open ;
end;
//关闭套接字连接，不再监听客户端的请求
procedure TfrmServerMain.tbDisconnectedClick(Sender: TObject);
begin
ServerSocket.Close;
StatusBar.Panels[0].Text :='服务器套接字连接已经关闭，无法接受客户端的连接请求.';
end;
//从客户端读取信息
procedure TfrmServerMain.ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
i:integer;
begin
//将从客户端读取的信息添加到Memo1中
Memo1.Lines.Add(Socket.ReceiveText);
for i:=0 to sessions do
begin
//取得匹配的客户端
if session[i].CHandle = Socket.SocketHandle then
begin
session[i].CSocket.SendText('回复客户端'+session[i].CAddress+' ==> '+Edit1.Text);
end;
end;
end;
//服务器端套接字进入监听状态，以便监听客户端的连接
procedure TfrmServerMain.ServerSocketListen(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar.Panels[0].Text :='等待客户端连接...';
end;
//当客户端连接到服务器端以后
procedure TfrmServerMain.ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
var
i,j:integer;
begin
j:=-1;
for i:=0 to sessions do
begin
//在原有的客户端连接数组中有中断的客户端连接
if not session[i].CUsed then
begin
session[i].CHandle := Socket.SocketHandle ;//客户端套接字句柄
session[i].CSocket := Socket; //客户端套接字
session[i].CName := Socket.RemoteHost ; //客户端计算机名称
session[i].CAddress := Socket.RemoteAddress ;//客户端计算机IP
session[i].CUsed := True; //连接数组当前位置已经占用
Break;
end;
j:=i;
end;
if j=sessions then
begin
inc(sessions);
session[j].CHandle := Socket.SocketHandle ;
session[j].CSocket := Socket;
session[j].CName := Socket.RemoteHost ;
session[j].CAddress := Socket.RemoteAddress ;
session[j].CUsed := True;
end;
StatusBar.Panels[0].Text := '客户端 '+Socket.RemoteHost + ' 已经连接';
end;
posted @
2008-11-07 15:20 YangHe 阅读(17) |
评论 (0) |
编辑
//当客户端断开连接时
procedure TfrmServerMain.ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
var
i:integer;
begin
for i:=0 to sessions do
begin
if session[i].CHandle =Socket.SocketHandle then
begin
session[i].CHandle :=0;
session[i].CUsed := False;
Break;
end;
end;
StatusBar.Panels[0].Text :='客户端 '+Socket.RemoteHost + ' 已经断开';
end;
//关闭窗口
procedure TfrmServerMain.tbCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmServerMain.FormCreate(Sender: TObject);
begin
sessions := 0;
end;
procedure TfrmServerMain.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
ServerSocket.Close ;
end;
//当客户端正在与服务器端连接时
procedure TfrmServerMain.ServerSocketGetSocket(Sender: TObject;
Socket: Integer; var ClientSocket: TServerClientWinSocket);
begin
StatusBar.Panels[0].Text :='客户端正在连接...';
end;
//客户端发生错误
procedure TfrmServerMain.ServerSocketClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
StatusBar.Panels[0].Text :='客户端'+Socket.RemoteHost +'发生错误！';
ErrorCode := 0;
end;
end.
２、客户端源码(uClientMain.pas)：
unit uClientMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, ComCtrls, ToolWin, ExtCtrls, StdCtrls, Buttons;
const
SocketHost = '172.16.1.6'; //服务器端地址
type
TfrmClientMain = class(TForm)
ControlBar1: TControlBar;
ToolBar1: TToolBar;
tbConnected: TToolButton;
tbSend: TToolButton;
tbClose: TToolButton;
tbDisconnected: TToolButton;
ClientSocket: TClientSocket;
Edit1: TEdit;
Memo1: TMemo;
StatusBar: TStatusBar;
btnSend: TBitBtn;
procedure tbConnectedClick(Sender: TObject);
procedure tbDisconnectedClick(Sender: TObject);
procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
procedure tbSendClick(Sender: TObject);
procedure tbCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketConnecting(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmClientMain: TfrmClientMain;
implementation
{$R *.DFM}
//打开套接字连接
procedure TfrmClientMain.tbConnectedClick(Sender: TObject);
begin
ClientSocket.Open ;
end;
//关闭套接字连接
procedure TfrmClientMain.tbDisconnectedClick(Sender: TObject);
begin
ClientSocket.Close;
end;
//接受服务器端的回复
procedure TfrmClientMain.ClientSocketRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Add(Socket.ReceiveText);
end;
//发送信息到服务器端
procedure TfrmClientMain.tbSendClick(Sender: TObject);
begin
ClientSocket.Socket.SendText(Edit1.Text);
end;
procedure TfrmClientMain.tbCloseClick(Sender: TObject);
begin
Close;
end;
//设置要连接的服务器端地址
procedure TfrmClientMain.FormShow(Sender: TObject);
begin
ClientSocket.Host := SocketHost;
end;
//已经连接到服务器端
procedure TfrmClientMain.ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
tbSend.Enabled := True;
tbDisconnected.Enabled :=True;
btnSend.Enabled := True;
StatusBar.Panels[0].Text := '已经连接到 '+ Socket.RemoteHost ;
end;
//正在连接到服务器端
procedure TfrmClientMain.ClientSocketConnecting(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar.Panels[0].Text := '正在连接到服务器... ' ;
end;
//当断开与服务器端的连接时发生
procedure TfrmClientMain.ClientSocketDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
tbSend.Enabled := False;
btnSend.Enabled := False;
tbDisconnected.Enabled := False;
StatusBar.Panels[0].Text := '已经断开与 '+ Socket.RemoteHost +' 的连接';
end;
procedure TfrmClientMain.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
ClientSocket.Close ;
end;
//当与服务器端的连接发生错误时
procedure TfrmClientMain.ClientSocketError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
StatusBar.Panels[0].Text := '与服务器端的连接发生错误';
ErrorCode := 0;
end;
end.
四、小结
上述方法是比较简单的实现方法，同时也是相对较容易理解的方法。通过这个方法，笔者成功实现了局域网内多个客户端与服务器端进行Socket通信的功能，同时可以保证一个客户端的连接、通信或是断开都不影响其它客户端的正常通信。
posted @
2008-11-07 15:20 YangHe 阅读(11) |
评论 (0) |
编辑
DELPHI中使用DLL的方法以及INSTALLSHIELD中使用DLL方法
调用DLL的方法无论是DELPHI还是INSTALLSHIELD，使用过程皆一致的，即声明，载入，使用，释放。
现在先看DELPHI调用DLL的情况，在此之前先用DELPHI做个DLL，现以一个创建SQL DB的CreateDB.DLL为例：
**********************************************************************
library CreateDB;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
SysUtils,
Classes,
ADODB, DB,
Windows,
Registry;
{$R *.res}
function MakeSqlServerCnn(strAddress,strUsername,strPassword,strDatabase:string):string;
begin
Result:='Provider=SQLOLEDB.1;'+
'Password='+strPassword+
';Persist Security Info=True;'+
'User ID='+strUsername+
';Initial Catalog='+strDatabase+
';Data Source='+strAddress+';';
end;
function MakeSqlServerCnn_WN(strAddress,strDatabase,Conn_Str:String):String;
begin
if Conn_Str='1' then
Result:='Provider=SQLOLEDB.1;'+
'Integrated Security=SSPI;Persist Security Info=False;User ID=sa;'+
'Initial Catalog='+strDatabase+
';Data Source='+strAddress+
';'
else
Result :='';
end;
Procedure GetValue(var ServerName,User,Mask,DBName,WN,BackupPath :String);
var
Reg :TRegistry;
begin
Reg :=TRegistry.Create;
Try
Reg.RootKey :=HKEY_LOCAL_MACHINE;
if Reg.OpenKey('SOFTWARE/Faceiv/HY1130',False) then
begin
ServerName :=Reg.ReadString('ServerName');
User :=Reg.ReadString('User');
Mask :=Reg.ReadString('Mask');
DBName :=Reg.ReadString('DBName');
WN :=Reg.ReadString('WN');
BackupPath :=Reg.ReadString('BackupPath');
end;
Finally
Reg.CloseKey;
Reg.Free;
End;
end;
Function CreateDataBase() :Boolean;
var
Step :integer;
Conn :TADOConnection;
Connc :TADOCommand;
ServerName,User,Mask,DBName,WN,BackupPath,DBPath :String;
begin
Try
Result :=False;
GetValue(ServerName,User,Mask,DBName,WN,BackupPath);
DBName :='Master';
WN:='1';
Conn :=TADOConnection.Create(nil);
Conn.LoginPrompt :=False;
//if WN='1' then
Conn.ConnectionString :=MakeSqlServerCnn_WN(ServerName,DBName,WN);
//else
// Conn.ConnectionString :=MakeSqlServerCnn(ServerName,User,Mask,DBName);
Conn.Connected :=True;
Connc :=TADOCommand.Create(nil);
Connc.Connection :=Conn;
DBPath :=Copy(BackupPath,1,Length(BackupPath)-6)+'DB/TimeBook';
Step :=0;
Connc.CommandText :='Use Master;Create DataBase TimeBook';
Connc.Execute;
Step :=1;
Connc.CommandText :='Restore DataBase TimeBook From Disk='''+DBPath+'''';
Connc.Execute;
Result :=True;
Except
if Step=0 then
Raise Exception.Create('创建数据库失败！');
if Step=1 then
Raise Exception.Create('恢复数据库失败！');
end;
end;
Exports
CreateDataBase;
begin
end.
*************************************************************************
注：由于这个DLL是为了INSTALLSHIELD中使用的，所以有个通过注册表进行信息传递的函数。
下面开始DELPHI中调用CreateDB.Dll的方法：
------------------------------------------------------------------------
1、声明：
Const
CreateDB ='CreateDB.dll';
type
TCreateDataBase =Function:Boolean;stdcall;
-------------------------------------------------------------------------
procedure TForm2.Button1Click(Sender: TObject);
var
CreateDataBase :TCreateDataBase;
Handle :integer;
begin
Handle :=LoadLibrary(CreateDB); //2、载入
if Handle >0 then
@CreateDataBase :=GetProcAddress(Handle,'CreateDataBase');
if @CreateDataBase<>nil then
if CreateDataBase then //3、使用
ShowMessage('SUCEED');
FreeLibrary(Handle); //4、释放
end;
*************************************************************************
动态调用最为常见，故只以动态调用为例，因为未指定此DLL的路径，所以只可与调用的程序放在一个目录下。
下面是INSTALLSHIELD中的DLL调用
prototype BOOL CreateDB.CreateDataBase(); //1、声明
function CreateDB()
STRING szDll;
NUMBER nResult;
begin
szDll =TARGETDIR^"Main//CreateDB.dll";
nResult = UseDLL (szDll); //2、载入
if (nResult =0) then
//MessageBox("UseDLL successful /n/n.DLL file loaded.",INFORMATION);
else
MessageBox("UseDLL failed./n/nCouldn't load CreateDB.DLL file.",INFORMATION);
abort;
endif;
if CreateDataBase() then //3、使用
//MessageBox("创建成功",INFORMATION);
else
MessageBox("创建失败",SEVERE);
abort;
endif;
if(UnUseDLL(szDll)<0) then //4、释放
MessageBox("UnUseDLL failed./n/nCreateDB.DLL still in memory.",SEVERE);
else
//MessageBox("UnUseDLL successful./n/n.DLL file removed from memory.",INFORMATION);
endif;
end;
*************************************************************************
posted @
2008-11-07 09:47 YangHe 阅读(87) |
评论 (0) |
编辑
在DELPHI的工程文件中
program Project1;
uses
Forms,
Unit1 in 'Unit1.pas' {Form1},
Windows,Messages,ShellApi;
{$R *.res}
var
HMutex:Hwnd;
Ret:Integer;
Reg :integer;
begin
Application.Initialize;
Application.Title :='这是一个防止多个实例运行的程序';
HMutex :=CreateMutex(nil,False,Pchar('这是一个防止多个实例运行的程序'));
Reg :=GetLastError;
if Reg<>ERROR_ALREADY_EXISTS then
begin
Application.CreateForm(TForm1, Form1);
end
else
begin
MessageBox(0,'实例已经运行了！','错误', MB_OK + MB_ICONERROR);
ReleaseMutex(hMutex);
end;
Application.Run;
end.
posted @
2008-11-07 09:46 YangHe 阅读(19) |
评论 (0) |
编辑
function TForm1.exe_is_running(const exeName:String) : Boolean; //exeName:不要扩展名的Exe主文件名
var
hCurrentWindow:HWnd;
szText:array[0..254] of char;
begin
Result := False;
hCurrentWindow:=Getwindow(Application.Handle,GW_HWNDFIRST);
while hCurrentWindow <> 0 do
begin
if Getwindowtext(hCurrentWindow,@sztext,255)>0 then
begin
if LowerCase(pchar(@sztext))=LowerCase(exeName) then
begin
Result := true;
Exit;
end;
end;
hCurrentWindow:=Getwindow(hCurrentwindow,GW_HWndNext);
end;
end;
posted @
2008-11-07 09:45 YangHe 阅读(23) |
评论 (0) |
编辑
1、Delphi中拷贝文件的几种方法
{方法一:用File stream }
Procedure FileCopy( Const sourcefilename, targetfilename: String );
Var
S, T: TFileStream;
Begin
S := TFileStream.Create( sourcefilename, fmOpenRead );
try
T := TFileStream.Create( targetfilename,fmOpenWrite or fmCreate );
try
T.CopyFrom(S, S.Size ) ;
finally
T.Free;
end;
finally
S.Free;
end;
End;
{ 方法二:使用内存块进行读写 }
procedure FileCopy(const FromFile, ToFile: string);
var
FromF, ToF: file;
NumRead, NumWritten: Word;
Buf: array[1..2048] of Char;
begin
AssignFile(FromF, FromFile);
Reset(FromF, 1);
AssignFile(ToF, ToFile);
Rewrite(ToF, 1);
repeat
BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
BlockWrite(ToF, Buf, NumRead, NumWritten);
until (NumRead = 0) or (NumWritten <> NumRead);
CloseFile(FromF);
CloseFile(ToF);
end;
posted @
2008-11-07 09:44 YangHe 阅读(22) |
评论 (0) |
编辑
如果一个对象单元中有其他单元需要调用的Func或Proc时怎么办，利用单元的对象引用？NO.虽然此方法常见，但非最好的。现用消息传递来实现。看例如下：
现设单元Main中的有个一Func CreateTV(在树状列表中显示员工信息)，子单元Epy(员工信息表)要添加或删除员工时，Main中的员工列表信息即时的更新。
第一步：定义消息常量
Const WM_Refresh=WM_USER+0001; (要确保这个消息常量可以被任何单元引用到)
第二步：在接受消息的单元中设定消息过程(本例中是Main单元)
type
TMain = class(Tform)
private
procedure RefTV(var msg :TMessage);message WM_REFRSH;
public
end;
var
Main: TMain;
implementation
{$R *.dfm}
procedure TMain.RefTV(var msg :TMessage);
begin
CreateTV;
end;
第三步：在发送消息的单元中添加发送操作(本例中是Epy单元)
１、获取接受消息单元的句柄(本例中是Main单元)
type
TEpy = class(Tform)
private
public
end;
var
Epy: TEpy;
EpyHandle :HWND:
implementation
{$R *.dfm}
procedure TEpy.FormCreate(Sender: TObject);
begin
EpyHandle :=FMain.Handle;
end;
2、在完成添加或删除操作后发送消息
procedure TEpy.InsertExecute(Sender: TObject);
begin
PostMessage(EpyHandle ,WM_REFRSH,0,0);
//Send
Message(EpyHandle ,WM_REFRSH,0,0);
end;
posted @
2008-11-07 09:44 YangHe 阅读(17) |
评论 (0) |
编辑
---- 在Delphi中预定义了Tfilestream类，通过它可以对磁盘文件进行读写，笔者选定
Tfilestream为基类，通过对其核心的两个读、写方法进行重载，编写定制的文件流，实现
对文件的读、写进行加密。
---- 首先，来看一下定制文件流（Tmystream）的声明：
type
Tmystream=class(Tfilestream)
private
fkey:string;
public
constructor create
(const filename:string;mode:word);
function read(var buffer;count:longint):
longint;override;
function write(const buffer;count:longint):
longint;override;
property key:string read fkey write fkey ;
end;
---- 在Tmystream的声名中，我们对read、write两个方法进行了重载，并添加了一个新的
特性key，用以存储对文件进行加密时所需的密码。为实现文件读写的加密，在write方法
中，将key的每个字符依次与buffer中的字符相加，将得到的结果写入文件，实现加密；
在read方法中，将读出的内容依次与key的每个字符相减，实现解密。加密及解密的方法
多种多样，读者可以通过改写相关代码，得到不同的加密方法。
程序清单如下：
function Tmystream.write(const buffer;
count:longint):longint;
var
Pbu,Pmy,mykey:pchar;
i,enc:integer;
begin
getmem(pmy,count); //为pmy分配内存
mykey:=pchar(key); //将key转换为pchar指针
try
pbu:=pchar(@buffer); //将buffer转换为pchar指针
for i:=0 to count-1 do
//将key的每个字符以此与buffer的
每个字符循环相加,结果放入pmy指向的内存区
begin
enc:=(ord(pbu[i])+ord(mykey
[(i mod length(key))])) mod 256;
Pmy[i]:=char(enc);
end;
result:=inherited write(Pmy^,count);
//将pmy指向的内容写入文件
finally
freemem(Pmy,count);
end;
end;
function Tmystream.read(var buffer;count:longint):
longint;
var
Pbu,Pmy,mykey:pchar;
i,mycount,enc:integer;
begin
getmem(Pmy,count);//为pmy分配内存
mykey:=pchar(key);//将key转换为pchar指针
try
mycount:=inherited read(Pmy^,count);
//将文件内容读入pmy指向内存区
Pbu:=Pchar(@buffer);将buffer转换为pchar指针
for i:=0 to mycount-1 do//将key的每个字符依次
与pmy的每个字符循环相减，结果放入pbu指向的变量
begin
enc:=(ord(Pmy[i])-ord(mykey
[(i mod length(key))])) mod 256;
Pbu[i]:=chr(enc);
end;
finally
freemem(Pmy,count);
end;
result:=mycount;
end;
---- 完成定制文件流的编写后，便可在程序中应用，实现文件的读写加密，例程如下：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls,unit2,unit3;
//unit2定义了Tmystream
//unit3定义了输入密码对话框form3
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Panel1: TPanel;
Panel2: TPanel;
Memo1: TMemo;
Splitter1: TSplitter;
Memo2: TMemo;
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button2Click(Sender: TObject);
//将选定的加密文件解开，读入memo2
var
encstr:Tmystream;
begin
if opendialog1.Execute and (form3.showmodal=mrok)
then
begin
encstr:=Tmystream.create
(opendialog1.filename,fmopenread);
encstr.key:=form3.Edit1.Text;
try
memo2.lines.LoadFromStream(encstr);
finally
encstr.Free;
end;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
//将memo1中的内容加密，用指定文件名另存
var
encstr:Tmystream;
begin
if savedialog1.Execute and (form3.showmodal=mrok)
then
begin
encstr:=Tmystream.create(savedialog1.filename,
fmcreate);
encstr.key:=form3.Edit1.Text;
try
memo1.lines.SaveToStream(encstr);
finally
encstr.Free;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
//将指定文件读入memo1
var
mystr:Tfilestream;
begin
if opendialog1.Execute then
begin
mystr:=Tfilestream.create
(opendialog1.filename,fmopenread);
try
memo1.lines.LoadFromStream(mystr);
finally
mystr.Free;
end;
end;
end;
end.
posted @
2008-11-07 09:42 YangHe 阅读(42) |
评论 (0) |
编辑
在Delphi7中用Indy开发Socket应用程序
笔者在前一段的工作中，需要开发一套简单的网络数据传输程序。由于平时常用Delphi做点开发，故此次也不例外。Delphi 7中带有两套TCP Socket组件：Indy Socket组件（IdTCPClient和IdTCPServer）和Delphi原生的TCP Socket组件（ClientSocket和ServerSocket）。但是，Borland已宣称ClientSocket和ServerSocket组件即将被废弃，建议用相应的Indy组件来代替。因此，笔者使用了Indy。本文在对Indy进行简要介绍的基础上，创建了一组简单的TCP Socket数据传输应用来演示了Indy的使用方法。
开放源代码的Internet组件集——Internet Direct（Indy）
Internet Direct（Indy）是一组开放源代码的Internet组件，涵盖了几乎所有流行的Internet协议。Indy用Delphi编写，被包含在Delphi 6，Kylix 1和C++ Builder 6及以上各个版本的Borland开发环境中。Indy曾经叫做WinShoes（双关于WinSock——Windows的Socket库），是由Chad Z. Hower领导的一群开发者构建的，可以从Indy的站点www.nevrona.com/indy上找到更多的信息并下载其新版本。到笔者撰写本文时为止，Indy的最新稳定版是9.0.14，Indy 10也进入了Beta测试阶段。
Delphi 7中所带的是Indy 9。在其的组件面板上，一共安装有100多个Indy组件。使用这些组件你可以开发基于各种协议的TCP客户和服务器应用程序，并处理相关的编码和安全问题。你可以通过前缀Id来识别Indy组件。
Indy是阻塞式（Blocking）的
当你使用Winsock开发网络应用程序时，从Socket中读取数据或者向Socket写入数据都是异步发生的，这样就不会阻断程序中其它代码的执行。在收到数据时，Winsock会向应用程序发送相应的消息。这种访问方式被称作非阻塞式连接，它要求你对事件作出响应，设置状态机，并通常还需要一个等待循环。
与通常的Winsock编程方法不同的是，Indy使用了阻塞式Socket调用方式。阻塞式访问更像是文件存取。当你读取数据，或是写入数据时，读取和写入函数将一直等到相应的操作完成后才返回。比如说，发起网络连接只需调用Connect方法并等待它返回，如果该方法执行成功，在结束时就直接返回，如果未能成功执行，则会抛出相应的异常。同文件访问不同的是，Socket调用可能会需要更长的时间，因为要读写的数据可能不会立即就能准备好（在很大程度上依赖于网络带宽）。
阻塞式Socket并非恶魔（Evil）
长期以来，阻塞式Socket都遭到了毫无理由的攻击。其实阻塞式Socket并非如通常所说的那样可怕。这还要从Winsock的发展说起。
当Socket被从Unix移植到Windows时，一个严重的问题立即就出现了。Unix支持fork，客户程序和服务器都能够fork新的进程，并启动这些进程，从而能够很方便地使用阻塞式Socket。而Windows 3.x既不支持fork也不支持多线程，当使用阻塞式Socket时，用户界面就会被“锁住”而无法响应用户输入。
为克服Windows 3.x的这一缺陷，微软在Winsock中加入了异步扩展，以使Winsock不会“锁住”应用程序的主线程（也是唯一的线程）。然而，这需要了一种完全不同的编程方式。于是有些人为了掩饰这一弱点，就开始强烈地诽谤阻塞式Socket。
当Win32出现的时候，它能够很好地支持线程。但是既成的观念已经很难更改，并且说出去的话也无法收回，因此对阻塞式Socket的诽谤继续存在着。
事实上，阻塞式Socket仍然是Unix实现Socket的唯一方式，并且它工作得很好。
阻塞式Socket的优点
归结起来，在Windows上使用阻塞式Socket开发应用程序具有如下优点：
○ 编程简单——阻塞式Socket应用程序很容易编写。所有的用户代码都写在同一个地方，并且顺序执行。
○ 容易向Unix移植——由于Unix也使用阻塞式Socket，编写可移植的代码就变得比较容易。Indy就是利用这一点来实现其多平台支持而又单一源代码的设计。
○ 很好地利用了线程技术——阻塞式Socket是顺序执行的，其固有的封装特性使得它能够很容易地使用到线程中。
阻塞式Socket的弱点
事物都具有两面性，阻塞式Socket也不例外。它的一个主要的缺点就是使客户程序的用户界面“冻结”。当在程序的主线程中进行阻塞式Socket调用时，由于要等待Socket调用完成并返回，这段时间就不能处理用户界面消息，使得Update、Repaint以及其它消息得不到及时响应，从而导致用户界面被“冻结”。
使用TIdAntiFreeze对抗“冻结”
Indy使用一个特殊的组件TIdAntiFreeze来透明地解决客户程序用户界面“冻结”的问题。TIdAntiFreeze在Indy内部定时中断对栈的调用，并在中断期间调用Application.ProcessMessages方法处理消息，而外部的Indy调用继续保存阻塞状态，就好像TIdAntiFreeze对象不存在一样。你只要在程序中的任意地方添加一个TIdAntiFreeze对象，就能在客户程序中利用到阻塞式Socket的所有优点而避开它的一些显著缺点。
Indy使用了线程技术
阻塞式Socekt通常都采用线程技术，Indy也是如此。从最底层开始，Indy的设计都是线程化的。因此用Indy创建服务器和客户程序跟在Unix下十分相似，并且Delphi的快速开发环境和Indy对WinSock的良好封装使得应用程序创建更加容易。
Indy服务器模型
一个典型的Unix服务器有一个或多个监听进程，它们不停地监听进入的客户连接请求。对于每一个需要服务的客户，都fork一个新进程来处理该客户的所有事务。这样一个进程只处理一个客户连接，编程就变得十分容易。
Indy服务器工作原理同Unix服务器十分类似，只是Windows不像Unix那样支持fork，而是支持线程，因此Indy服务器为每一个客户连接分配一个线程。
图1显示了Indy服务器的工作原理。Indy服务器组件创建一个同应用程序主线程分离的监听线程来监听客户连接请求，对于接受的每一个客户，都创建一个新的线程来为该客户提供服务，所有与这一客户相关的事务都由该线程来处理。
使用组件TIdThreadMgrPool，Indy还支持线程池。
图1 Indy服务器工作原理
线程与Indy客户程序
Indy客户端组件并未使用线程。但是在一些高级的客户程序中，程序员可以在自定义的线程中使用Indy客户端组件，以使用户界面更加友好。
简单的Indy应用示例
下面将创建一个简单的TCP客户程序和一个简单的TCP服务器来演示Indy的基本使用方法。客户程序使用TCP协议同服务器连接，并向服务器发送用户所输入数据。服务器支持两条命令：DATA和QUIT。在DATA命令后跟随要发送的数据，并用空格将命令字DATA和数据分隔开。
表单布局
建立一个项目组，添加一个客户程序项目和一个服务器项目。客户程序和服务器程序的表单布局如同2和图3所示。客户程序表单上放置了TIdTCPClient组件，服务器程序表单上放置了TIdTCPServer组件。为防止客户程序“冻结”，还在其表单上放置TIdAntiFreeze组件。
客户程序和服务器程序的表单上都放置有TListBox组件，用来显示通信记录。
图2 简单的TCP客户程序表单
图3 简单的TCP服务器程序表单
客户程序代码
客户程序片断如代码列表1所示。
代码列表1
procedure TFormMain.BtnConnectClick(Sender: TObject);
begin
IdTCPClient.Host := EdtHost.Text;
IdTCPClient.Port := StrToInt(EdtPort.Text);
LbLog.Items.Add('正在连接 ' + EdtHost.Text + '...');
with IdTCPClient do
begin
try
Connect(5000);
try
LbLog.Items.Add(ReadLn());
BtnConnect.Enabled := False;
BtnSend.Enabled := True;
BtnDisconnect.Enabled := True;
except
LbLog.Items.Add('远程主机无响应！');
IdTCPClient.Disconnect();
end;//end try
except
LbLog.Items.Add('无法建立到' + EdtHost.Text + '的连接！');
end;//end try
end;//end with
end;
procedure TFormMain.BtnSendClick(Sender: TObject);
begin
LbLog.Items.Add('DATA ' + EdtData.Text);
with IdTCPClient do
begin
try
WriteLn('DATA ' + EdtData.Text);
LbLog.Items.Add(ReadLn())
except
LbLog.Items.Add('发送数据失败！');
IdTCPClient.Disconnect();
LbLog.Items.Add('同主机 ' + EdtHost.Text + ' 的连接已断开！');
BtnConnect.Enabled := True;
BtnSend.Enabled := False;
BtnDisconnect.Enabled := False;
end;//end try
end;//end with
end;
procedure TFormMain.BtnDisconnectClick(Sender: TObject);
var
Received: string;
begin
LbLog.Items.Add('QUIT');
try
IdTCPClient.WriteLn('QUIT');
finally
IdTCPClient.Disconnect();
LbLog.Items.Add('同主机 ' + EdtHost.Text + ' 的连接已断开！');
BtnConnect.Enabled := True;
BtnSend.Enabled := False;
BtnDisconnect.Enabled := False;
end;//end try
end;
在“连接”按钮事件响应过程中，首先根据用户输入设置IdTCPClient的主机和端口，并调用IdTCPClient的Connect方法向服务器发出连接请求。然后调用ReadLn方法读取服务器应答数据。
在“发送”按钮事件响应过程中，调用WriteLn方法写DATA命令，向服务器发送数据。
在“断开”按钮事件响应过程中，向服务器发送QUIT命令，并调用Disconnect方法断开连接。
程序中还包含有通信信息记录和异常处理的代码。
服务器程序代码
服务器程序片断如代码列表2所示。
代码列表2
procedure TFormMain.BtnStartClick(Sender: TObject);
begin
IdTCPServer.DefaultPort := StrToInt(EdtPort.Text);
IdTCPServer.Active := True;
BtnStart.Enabled := False;
BtnStop.Enabled := True;
LbLog.Items.Add('服务器已成功启动！');
end;
procedure TFormMain.BtnStopClick(Sender: TObject);
begin
IdTCPServer.Active := False;
BtnStart.Enabled := True;
BtnStop.Enabled := False;
LbLog.Items.Add('服务器已成功停止！');
end;
procedure TFormMain.IdTCPServerConnect(AThread: TIdPeerThread);
begin
LbLog.Items.Add('来自主机 '
+ AThread.Connection.Socket.Binding.PeerIP
+ ' 的连接请求已被接纳！');
AThread.Connection.WriteLn('100: 欢迎连接到简单TCP服务器！');
end;
procedure TFormMain.IdTCPServerExecute(AThread: TIdPeerThread);
var
sCommand: string;
begin
with AThread.Connection do
begin
sCommand := ReadLn();
FLogEntry := sCommand + ' 来自于主机 '
+ AThread.Connection.Socket.Binding.PeerIP;
AThread.Synchronize(AddLogEntry);
if AnsiStartsText('DATA ', sCommand) then
begin
FReceived := RightStr(sCommand, Length(sCommand)-5);
WriteLn('200: 数据接收成功！');
AThread.Synchronize(DisplayData);
end
else if SameText(sCommand, 'QUIT') then begin
FLogEntry := '断开同主机 '
+ AThread.Connection.Socket.Binding.PeerIP
+ ' 的连接！';
AThread.Synchronize(AddLogEntry);
Disconnect;
end
else begin
WriteLn('500: 无法识别的命令！');
FLogEntry := '无法识别命令：' + sCommand;
AThread.Synchronize(AddLogEntry);
end;//endif
end;
end;
procedure TFormMain.DisplayData();
begin
EdtData.Text := FReceived;
end;
procedure TFormMain.AddLogEntry();
begin
LbLog.Items.Add(FLogEntry);
end;
“启动”按钮设置IdTCPServer 的Active属性为True来启动服务器，“停止”按钮设置Active属性为False来关闭服务器。
IdTCPServerConnect方法作为IdTCPServer 的OnCorrect事件响应过程，向客户端发送欢迎信息。OnCorrect事件在一个客户连接请求被接受时发生，为该连接创建的线程AThread被作为参数传递给IdTCPServerConnect方法。
IdTCPServerExecute方法是IdTCPServer 的OnExecute事件响应过程。OnExecute事件在TIdPeerThread对象试图执行其Run方法时发生。OnExecute事件与通常的事件有所不同，其响应过程是在某个线程上下文中执行的，参数AThread就是调用它的线程。这一点很重要，它意味着可能有多个OnExecute事件响应过程被同时执行。在连接被断开或中断前，OnExecute事件响应过程会被反复执行。
在IdTCPServerExecute方法中，首先读入一条指令，然后对指令进行判别。如果是DATA指令，就解出数据并显示它。如果收到的是QUIT指令，则断开连接。需要特别指出的是，由于IdTCPServerExecute方法在某一线程上下文中执行，因此显示数据和添加事件记录都是将相应的方法传递给Synchronize调用来完成的。
运行程序
运行客户端和服务器程序，按如下流程进行操作：
1.按服务器程序的“启动”按钮启动服务器；
2.按客户程序的“连接”按钮，建立同服务器的连接；
3.在客户程序的待发送数据编辑框中输入“Hello, Indy!”，并按“发送”按钮发送数据；
4.按客户程序的“断开”按钮，断开同服务器的连接；
5.按服务器程序的“停止”按钮停止服务器。
程序运行的结果如图4和图5所示。
图4 简单的TCP客户
图5 简单的TCP服务器
更多信息
要了解更多的关于Indy的信息，可以参阅：
[1] Indy主页www.nevrona.com/indy；
[2] Indy的帮助文件；
[3] http://www.swissdelphicenter.com/en/indyarticles.php上有关Indy的文章；
[4] Chad Z. Hower（Indy的原始作者）和Hadi Hariri合著的“Indy In Depth”，可以从http://www.atozedsoftware.com/找到；
[5] Marco Cantu著，Sybex出版“Mastering Delphi 7”中相关的章节。
|
扫一扫
1248
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
