菩提树

菩提本无树,明镜亦非台,本来无一物,何处惹尘埃。
机动车检测 www.cnmvd.com

逝者如斯
网志分类
· 所有网志
· 痞子语录
· 涂涂留言
· VB
· DELPHI
· VC
· SQL
· 车辆检测
· 摘抄文字
· 音乐图片
· 未分类
最新评论
搜索本站
友情链接
· 我们的小歪
· 管理我的Blog

订阅 RSS

0069781

歪酷博客


痞子 @ 2008-01-18 15:01

一、准备工作|
1、下载IntraWeb v9.0.15,http://downloads.atozed.com/intraweb/iw9.0.16.exe
2、下载TMS v2.9.0.0 for IntraWeb and for Delphi2006,http://users.pandora.be/tmssoftware/TMSIWD2006.ZIP(for Delphi 2007的下载地址则为http://users.pandora.be/tmssoftware/TMSIWD2007.ZIP

二、安装
查看更多精彩图片0 && image.height>0){if(image.width>=510){this.width=510;this.height=image.height*510/image.width;}}" border=0>

查看更多精彩图片0 && image.height>0){if(image.width>=510){this.width=510;this.height=image.height*510/image.width;}}" border=0>

查看更多精彩图片0 && image.height>0){if(image.width>=510){this.width=510;this.height=image.height*510/image.width;}}" border=0>

查看更多精彩图片0 && image.height>0){if(image.width>=510){this.width=510;this.height=image.height*510/image.width;}}" border=0>

查看更多精彩图片0 && image.height>0){if(image.width>=510){this.width=510;this.height=image.height*510/image.width;}}" border=0>

查看更多精彩图片0 && image.height>0){if(image.width>=510){this.width=510;this.height=image.height*510/image.width;}}" border=0>

查看更多精彩图片0 && image.height>0){if(image.width>=510){this.width=510;this.height=image.height*510/image.width;}}" border=0>

查看更多精彩图片0 && image.height>0){if(image.width>=510){this.width=510;this.height=image.height*510/image.width;}}" border=0>
License Information窗口,点“Next”即可
查看更多精彩图片0 && image.height>0){if(image.width>=510){this.width=510;this.height=image.height*510/image.width;}}" border=0>

查看更多精彩图片0 && image.height>0){if(image.width>=510){this.width=510;this.height=image.height*510/image.width;}}" border=0>

查看更多精彩图片0 && image.height>0){if(image.width>=510){this.width=510;this.height=image.height*510/image.width;}}" border=0>

查看更多精彩图片0 && image.height>0){if(image.width>=510){this.width=510;this.height=image.height*510/image.width;}}" border=0>
到此,IntraWeb安装完毕。
运行Delphi2006,新建一个IntraWeb工程,运行
查看更多精彩图片0 && image.height>0){if(image.width>=510){this.width=510;this.height=image.height*510/image.width;}}" border=0>
是Evalution Mode。


三、破解IntraWeb
1、程序\IntraWeb\License Registration
查看更多精彩图片0 && image.height>0){if(image.width>=510){this.width=510;this.height=image.height*510/image.width;}}" border=0>
2、输入
在License Registration里面输入:+007TmFtZT1CcnVubyBGaWVyZW5zDQpDb21wYW55PVRNUyBTb2Z0d2FyZQ0KRXhwaXJhdGlvbj0y MDA1MDgxMA0KRWRpdGlvbj1FbnRlcnByaXNlDQpTZXJpYWxObz03MjI2NTMwNg0KU2NyYW1ibGVyPTM3NjY 2Ljg0NDk2ODcwMzcNCg=='#13#10'h5lFPcAQ5RlKQ0Trd11PiyKowGCIPwmOLNz5W3JgmVeCwGqMQrsl3Q==
查看更多精彩图片0 && image.height>0){if(image.width>=510){this.width=510;this.height=image.height*510/image.width;}}" border=0>
3、修改IWKlooch.dcu文件
在安装目录下,如D:\Program Files\Intraweb 9.0\LibBDS4,找到IWKlooch.dcu,然后用如UltraEdit打开IWKlooch.dcu,把B301全部换成B304就可以了。

相应地对于TMS.v.2.9.0.0版本,安装完毕后可打开D:\Program Files\tmssoftware\TMSIWPROSE\IWTMSBase.dcu及IWWebGrid.dcu,查找01 73 13 A1替换成01 73 13 C3即可。

四、运行情况
1、运行Delphi 2006,可能会出现如下图“无法找到组件”的错误提示
查看更多精彩图片0 && image.height>0){if(image.width>=510){this.width=510;this.height=image.height*510/image.width;}}" border=0>
只要打开iw9tmsd2006.bdsproj,重新Install就可以的。
查看更多精彩图片0 && image.height>0){if(image.width>=510){this.width=510;this.height=image.height*510/image.width;}}" border=0>
运行D:\Program Files\tmssoftware\TMSIWPROSE\Features Demo\IW9FeaturesDemo.exe,界面如下,端口4321,可见IntaWeb和TMS已经不再是评估版了。
查看更多精彩图片0 && image.height>0){if(image.width>=510){this.width=510;this.height=image.height*510/image.width;}}" border=0>
查看更多精彩图片0 && image.height>0){if(image.width>=510){this.width=510;this.height=image.height*510/image.width;}}" border=0>



 
痞子 @ 2008-01-12 18:58

设置Delphi6的Edit控件
BevelKind:=bkFlat,
BevelEages的beBottom为True其他为False
BorderStyle为bsNone,
BevelInner:=bvNone,
BevelOuter:=bvLowered就能实现。

ParentColor:=True  透明



 
痞子 @ 2008-01-12 18:45

◇[DELPHI]网络邻居复制文件
uses shellapi;
copyfile(pchar('newfile.txt'),pchar('//computername/direction/targer.txt'),false);

◇[DELPHI]产生鼠标拖动效果
通过MouseMove事件、DragOver事件、EndDrag事件实现,例如在PANEL上的LABEL:
var xpanel,ypanel,xlabel,ylabel:integer;
PANEL的MouseMove事件:xpanel:=x;ypanel:=y;
PANEL的DragOver 事件:xpanel:=x;ypanel:=y;
LABEL的MouseMove事件:xlabel:=x;ylabel:=y;
LABEL的EndDrag  事件:label.left:=xpanel-xlabel;label.top:=ypanel-ylabel;

◇[DELPHI]取得WINDOWS目录
uses shellapi;
var windir:array[0..255] of char;
getwindowsdirectory(windir,sizeof(windir));
或者从注册表中读取,位置:
HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion
SystemRoot键,取得如:C:\WINDOWS

◇[DELPHI]在FORM或其他容器上画线
var x,y:array [0..50] of integer;
canvas.pen.color:=clred;
canvas.pen.style:=psDash;
form1.canvas.moveto(trunc(x[i]),trunc(y[i]));
form1.canvas.lineto(trunc(x[j]),trunc(y[j]));

◇[DELPHI]字符串列表使用
var tips:tstringlist;
tips:=tstringlist.create;
tips.loadfromfile('filename.txt');
edit1.text:=tips[0];
tips.add('last line addition string');
tips.insert(1,'insert string at NO 2 line');
tips.savetofile('newfile.txt');
tips.free;

◇[DELPHI]简单的剪贴板操作
richedit1.selectall;
richedit1.copytoclipboard;
richedit1.cuttoclipboard;
edit1.pastefromclipboard;

◇[DELPHI]关于文件、目录操作
Chdir('c:\abcdir');转到目录
Mkdir('dirname');建立目录
Rmdir('dirname');删除目录
GetCurrentDir;//取当前目录名,无'\'
Getdir(0,s);//取工作目录名s:='c:\abcdir';
Deletfile('abc.txt');//删除文件
Renamefile('old.txt','new.txt');//文件更名
ExtractFilename(filelistbox1.filename);//取文件名
ExtractFileExt(filelistbox1.filename);//取文件后缀

◇[DELPHI]处理文件属性
attr:=filegetattr(filelistbox1.filename);
if (attr and faReadonly)=faReadonly then ... //只读
if (attr and faSysfile)=faSysfile then ... //系统
if (attr and faArchive)=faArchive then ... //存档
if (attr and faHidden)=faHidden then ... //隐藏

◇[DELPHI]执行程序外文件
WINEXEC//调用可执行文件
winexec('command.com /c copy *.* c:\',SW_Normal);
winexec('start abc.txt');
ShellExecute或ShellExecuteEx//启动文件关联程序
function executefile(const filename,params,defaultDir:string;showCmd:integer):THandle;
ExecuteFile('C:\abc\a.txt','x.abc','c:\abc\',0);
ExecuteFile('http://tingweb.yeah.net','','',0);
ExecuteFile('mailto:tingweb@wx88.net','','',0);

◇[DELPHI]取得系统运行的进程名
var hCurrentWindow:HWnd;szText:array[0..254] of char;
begin
hCurrentWindow:=Getwindow(handle,GW_HWndFrist);
while hCurrentWindow <> 0 do
begin
if Getwindowtext(hcurrnetwindow,@sztext,255)>0 then listbox1.items.add(strpas(@sztext));
hCurrentWindow:=Getwindow(hCurrentwindow,GW_HWndNext);
end;
end;

◇[DELPHI]关于汇编的嵌入
Asm End;
可以任意修改EAX、ECX、EDX;不能修改ESI、EDI、ESP、EBP、EBX。

◇[DELPHI]关于类型转换函数
FloatToStr//浮点转字符串
FloatToStrF//带格式的浮点转字符串
IntToHex//整数转16进制
TimeToStr
DateToStr
DateTimeToStr
FmtStr//按指定格式输出字符串
FormatDateTime('YYYY-MM-DD,hh-mm-ss',DATE);

◇[DELPHI]字符串的过程和函数
Insert(obj,target,pos);//字符串target插入在pos的位置。如插入结果大于target最大长度,多出字符将被截掉。如Pos在255以外,会产生运行错。例如,st:='Brian',则Insert('OK',st,2)会使st变为'BrOKian'。
Delete(st,pos,Num);//从st串中的pos(整型)位置开始删去个数为Num(整型)个字符的子字串。例如,st:='Brian',则Delete(st,3,2)将变为Brn。
Str(value,st);//将数值value(整型或实型)转换成字符串放在st中。例如,a=2.5E4时,则str(a:10,st)将使st的值为' 25000'。
Val(st,var,code);//把字符串表达式st转换为对应整型或实型数值,存放在var中。St必须是一个表示数值的字符串,并符合数值常数的规则。在转换过程中,如果没有检测出错误,变量code置为0,否则置为第一个出错字符的位置。例如,st:=25.4E3,x是一个实型变量,则val(st,x,code)将使X值为25400,code值为0。
Copy(st.pos.num);//返回st串中一个位置pos(整型)处开始的,含有num(整型)个字符的子串。如果pos大于st字符串的长度,那就会返回一个空串,如果pos在255以外,会引起运行错误。例如,st:='Brian',则Copy(st,2,2)返回'ri'。
Concat(st1,st2,st3……,stn);//把所有自变量表示出的字符串按所给出的顺序连接起来,并返回连接后的值。如果结果的长度255,将产生运行错误。例如,st1:='Brian',st2:=' ',st3:='Wilfred',则Concat(st1,st2,st3)返回'Brian Wilfred'。
Length(st);//返回字符串表达式st的长度。例如,st:='Brian',则Length(st)返回值为5。
Pos(obj,target);//返回字符串obj在目标字符串target的第一次出现的位置,如果target没有匹配的串,Pos函数的返回值为0。例如,target:='Brian Wilfred',则Pos('Wil',target)的返回值是7,Pos('hurbet',target)的返回值是0。

◇[DELPHI]关于处理注册表
uses Registry;
var reg:Tregistry;
reg:=Tregistry.create;
reg.rootkey:='HKey_Current_User';
reg.openkey('Control Panel\Desktop',false);
reg.WriteString('Title Wallpaper','0');
reg.writeString('Wallpaper',filelistbox1.filename);
reg.closereg;
reg.free;

◇[DELPHI]关于键盘常量名
VK_BACK/VK_TAB/VK_RETURN/VK_SHIFT/VK_CONTROL/VK_MENU/VK_PAUSE/VK_ESCAPE
/VK_SPACE/VK_LEFT/VK_RIGHT/VK_UP/VK_DOWN
F1--F12:(112)--B(123)
A-Z:(65)--A(90)
0-9:(48)--(57)

◇[DELPHI]初步判断程序母语
DELPHI软件的DOS提示:This Program Must Be Run Under Win32.
VC++软件的DOS提示:This Program Cannot Be Run In DOS Mode.

◇[DELPHI]操作Cookie
response.cookies("name").domain:='http://www.086net.com';
with response.cookies.add do
begin
name:='username';
value:='username';
end

◇[DELPHI]增加到文档菜单连接
uses shellapi,shlOBJ;
shAddToRecentDocs(shArd_path,pchar(filepath));//增加连接
shAddToRecentDocs(shArd_path,nil);//清空

◇[杂类]备份智能ABC输入法词库
windows\system\user.rem
windows\system\tmmr.rem

◇[DELPHI]判断鼠标按键
if GetAsyncKeyState(VK_LButton)<>0 then ... //左键
if GetAsyncKeyState(VK_MButton)<>0 then ... //中键
if GetAsyncKeyState(VK_RButton)<>0 then ... //右键

◇[DELPHI]设置窗体的最大显示
onFormCreate事件
self.width:=screen.width;
self.height:=screen.height;

◇[DELPHI]按键接受消息
OnCreate事件中处理:Application.OnMessage:=MyOnMessage;
procedure TForm1.MyOnMessage(var MSG:TMSG;var Handle:Boolean);
begin
if msg.message=256 then ... //ANY键
if msg.message=112 then ... //F1
if msg.message=113 then ... //F2
end;

◇[杂类]隐藏共享文件夹
共享效果:可访问,但不可见(在资源管理、网络邻居中)
取共享名为:direction$
访问://computer/dirction/

◇[Java Script]Java Script网页常用效果
网页60秒定时关闭
关闭窗口
关闭
定时转URL
数据源,一个是MQIS,一个是LocalSever,任选一个选后点击配置按钮,不知你的SQL7.0
是不是安装在本地机器上,如果是的话直接进行下一步,如果不是,在服务器一栏中填上
Server,然后进行下一步,填写登录ID 和密码(登录ID,和密码是在SQL7.0中的用户选项
中设的)。
第二步,配置BDE:
打开Delphi的BDE,然后点击MQIS 或 LocalServer,就会提示用户名和密码,这和
ODBC的用户名和密码是一样的,填上就行了。
第三步,配置程序:
如果用的是TTable,就在TTable的DatabaseName中选择MQIS 或LocalServer,然后在
TableName中选择Sale就行了,然后将Active改为True,Delphi弹出提示对话,填入用户
名和密码。
如果用的是TQuery,在TQuery上点击右键,再击"SQL Builder",这是以界面方式配置
SQL语句,或者在TQuery的SQL中填入SQL语句。最后,别忘了将Active改为True。
在运行也可能配置TQuery,具体见Delphi帮助。

◇[DELPHI]得到图像上某一点的RGB值
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
red,green,blue:byte ;
i:integer;
begin
i:= image1.Canvas.Pixels[x,y];
Blue:= GetBValue(i);
Green:= GetGValue(i):
Red:= GetRValue(i);
Label1.Caption:=inttostr(Red);
Label2.Caption:=inttostr(Green);
Label3.Caption:=inttostr(Blue);
end;

◇[DELPHI]关于日期格式分解转换
var year,month,day:word;now2:Tdatatime;
now2:=date();
decodedate(now2,year,month,day);
lable1.Text :=inttostr(year)+'年'+inttostr(month)+'月'+inttostr(day)+'日';

◇[DELPHI]如何判断当前网络连接方式
判断结果是MODEM、局域网或是代理服务器方式。
uses wininet;
Function ConnectionKind :boolean;
var flags: dword;
begin
Result := InternetGetConnectedState(@flags, 0);
if Result then
begin
if (flags and INTERNET_CONNECTION_MODEM) = INTERNET_CONNECTION_MODEM then
begin
showmessage('Modem');
end;
if (flags and INTERNET_CONNECTION_LAN) = INTERNET_CONNECTION_LAN then
begin
showmessage('LAN');
end;
if (flags and INTERNET_CONNECTION_PROXY) = INTERNET_CONNECTION_PROXY then
begin
showmessage('Proxy');
end;
if (flags and INTERNET_CONNECTION_MODEM_BUSY)=INTERNET_CONNECTION_MODEM_BUSY then
begin
showmessage('Modem Busy');
end;
end;
end;

◇[DELPHI]如何判断字符串是否是有效EMAIL地址
function IsEMail(EMail: String): Boolean;
var s: String;ETpos: Integer;
begin
ETpos:= pos('@', EMail);
if ETpos > 1 then
begin
s:= copy(EMail,ETpos+1,Length(EMail));
if (pos('.', s) > 1) and (pos('.', s) < length(s)) then
Result:= true else Result:= false;
end
else
Result:= false;
end;

◇[DELPHI]判断系统是否连接INTERNET
需要引入URL.DLL中的InetIsOffline函数。
函数申明为:
function InetIsOffline(Flag: Integer): Boolean; stdcall; external 'URL.DLL';
然后就可以调用函数判断系统是否连接到INTERNET
if InetIsOffline(0) then ShowMessage('not connected!')
else ShowMessage('connected!');
该函数返回TRUE如果本地系统没有连接到INTERNET。
附:
大多数装有IE或OFFICE97的系统都有此DLL可供调用。
InetIsOffline
BOOL InetIsOffline(
DWORD dwFlags,
);

◇[DELPHI]简单地播放和暂停WAV文件
uses mmsystem;
function PlayWav(const FileName: string): Boolean;
begin
Result := PlaySound(PChar(FileName), 0, SND_ASYNC);
end;
procedure StopWav;
var
buffer: array[0..2] of char;
begin
buffer[0] := #0;
PlaySound(Buffer, 0, SND_PURGE);
end;

◇[DELPHI]取机器BIOS信息
with Memo1.Lines do
begin
Add('MainBoardBiosName:'+^I+string(Pchar(Ptr($FE061))));
Add('MainBoardBiosCopyRight:'+^I+string(Pchar(Ptr($FE091))));
Add('MainBoardBiosDate:'+^I+string(Pchar(Ptr($FFFF5))));
Add('MainBoardBiosSerialNo:'+^I+string(Pchar(Ptr($FEC71))));
end;

◇[DELPHI]网络下载文件
uses UrlMon;
function DownloadFile(Source, Dest: string): Boolean;
begin
try
Result := UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;
except
Result := False;
end;
end;
if DownloadFile('http://www.borland.com/delphi6.zip, 'c:\kylix.zip') then
ShowMessage('Download succesful')
else ShowMessage('Download unsuccesful')

◇[DELPHI]解析服务器IP地址
uses winsock
function IPAddrToName(IPAddr : String): String;
var
SockAddrIn: TSockAddrIn;
HostEnt: PHostEnt;
WSAData: TWSAData;
begin
WSAStartup(1, WSAData);
SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(IPAddr));
HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
if HostEnt<>nil then result:=StrPas(Hostent^.h_name) else result:='';
end;

◇[DELPHI]取得快捷方式中的连接
function ExeFromLink(const linkname: string): string;
var
FDir,
FName,
ExeName: PChar;
z: integer;
begin
ExeName:= StrAlloc(MAX_PATH);
FName:= StrAlloc(MAX_PATH);
FDir:= StrAlloc(MAX_PATH);
StrPCopy(FName, ExtractFileName(linkname));
StrPCopy(FDir, ExtractFilePath(linkname));
z:= FindExecutable(FName, FDir, ExeName);
if z > 32 then
Result:= StrPas(ExeName)
else
Result:= '';
StrDispose(FDir);
StrDispose(FName);
StrDispose(ExeName);
end;

◇[DELPHI]控制TCombobox的自动完成
{'Sorted' property of the TCombobox to true }
var lastKey: Word; //全局变量
//TCombobox的OnChange事件
procedure TForm1.AutoCompleteChange(Sender: TObject);
var
SearchStr: string;
retVal: integer;
begin
SearchStr := (Sender as TCombobox).Text;
if lastKey <> VK_BACK then // backspace: VK_BACK or  
begin
retVal := (Sender as TCombobox).Perform(CB_FINDSTRING, -1, LongInt(PChar(SearchStr)));
if retVal > CB_Err then
begin
(Sender as TCombobox).ItemIndex := retVal;
(Sender as TCombobox).SelStart := Length(SearchStr);
(Sender as TCombobox).SelLength :=
(Length((Sender as TCombobox).Text) - Length(SearchStr));
end; // retVal > CB_Err
end; // lastKey <> VK_BACK
lastKey := 0; // reset lastKey
end;
//TCombobox的OnKeyDown事件
procedure TForm1.AutoCompleteKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
lastKey := Key;
end;

◇[DELPHI]如何清空一个目录
function EmptyDirectory(TheDirectory :String ; Recursive : Boolean) :
Boolean;
var
SearchRec : TSearchRec;
Res : Integer;
begin
Result := False;
TheDirectory := NormalDir(TheDirectory);
Res := FindFirst(TheDirectory + '*.*', faAnyFile, SearchRec);
try
while Res = 0 do
begin
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
if ((SearchRec.Attr and faDirectory) > 0) and Recursive
then begin
EmptyDirectory(TheDirectory + SearchRec.Name, True);
RemoveDirectory(PChar(TheDirectory + SearchRec.Name));
end
else begin
DeleteFile(PChar(TheDirectory + SearchRec.Name))
end;
end;
Res := FindNext(SearchRec);
end;
Result := True;
finally
FindClose(SearchRec.FindHandle);
end;
end;

◇[DELPHI]如何计算一个目录的大小
function GetDirectorySize(const ADirectory: string): Integer;
var
Dir: TSearchRec;
Ret: integer;
Path: string;
begin
Result := 0;
Path := ExtractFilePath(ADirectory);
Ret := Sysutils.FindFirst(ADirectory, faAnyFile, Dir);
if Ret <> NO_ERROR then exit;
try
while ret=NO_ERROR do
begin
inc(Result, Dir.Size);
if (Dir.Attr in [faDirectory]) and (Dir.Name[1] <> '.') then
Inc(Result, GetDirectorySize(Path + Dir.Name + '\*.*'));
Ret := Sysutils.FindNext(Dir);
end;
finally
Sysutils.FindClose(Dir);
end;
end;

◇[DELPHI]安装程序如何添加到Uninstall列表
操作注册表,如下:
1.在HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall键下建立一个主键,名称任意。
例HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\MyUninstall
2.在HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\MyUnistall下键两个串值,
这两个串值的名称是特定的:DisplayName和UninstallString。
3.给串DisplayName赋值为显示在“删除应用程序列表”中的名称,如'Aiming Uninstall one';
给串UninstallString赋值为执行的删除命令,如 C:\WIN97\uninst.exe -f"C:\TestPro\aimTest.isu"

◇[DELPHI]截获WM_QUERYENDSESSION关机消息
type
TForm1 = class(TForm)
procedure WMQueryEndSession(var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;
procedure CMEraseBkgnd(var Message:TWMEraseBkgnd);Message WM_ERASEBKGND;
private
{ Private declarations }
public
{ Public declarations }
end;
procedure TForm1.WMQueryEndSession(var Message: TWMQueryEndSession);
begin
Showmessage('computer is about to shut down');
end;

◇[DELPHI]获取网上邻居
procedure getnethood();//NT做服务器,WIN98上调试通过。
var
a,i:integer;
errcode:integer;
netres:array[0..1023] of netresource;
enumhandle:thandle;
enumentries:dword;
buffersize:dword;
s:string;
mylistitems:tlistitems;
mylistitem:tlistitem;
alldomain:tstrings;
begin //listcomputer is a listview to list all computers;controlcenter is a form.
alldomain:=tstringlist.Create ;
with netres[0] do begin
dwscope :=RESOURCE_GLOBALNET;
dwtype :=RESOURCETYPE_ANY;
dwdisplaytype :=RESOURCEDISPLAYTYPE_DOMAIN;
dwusage :=RESOURCEUSAGE_CONTAINER;
lplocalname :=nil;
lpremotename :=nil;
lpcomment :=nil;
lpprovider :=nil;
end; // 获取所有的域
errcode:=wnetopenenum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY,RESOURCEUSAGE_CONTAINER,@netres[0],enumhandle);
if errcode=NO_ERROR then begin
enumentries:=1024;
buffersize:=sizeof(netres);
errcode:=wnetenumresource(enumhandle,enumentries,@netres[0],buffersize);
end;
a:=0;
mylistitems :=controlcenter.lstcomputer.Items ;
mylistitems.Clear ;
while (string(netres[a].lpprovider)<>'') and (errcode=NO_ERROR) do
begin
alldomain.Add (netres[a].lpremotename);
a:=a+1;
end;
wnetcloseenum(enumhandle);
// 获取所有的计算机
mylistitems :=controlcenter.lstcomputer.Items ;
mylistitems.Clear ;
for i:=0 to alldomain.Count-1 do
begin
with netres[0] do begin
dwscope :=RESOURCE_GLOBALNET;
dwtype :=RESOURCETYPE_ANY;
dwdisplaytype :=RESOURCEDISPLAYTYPE_SERVER;
dwusage :=RESOURCEUSAGE_CONTAINER;
lplocalname :=nil;
lpremotename :=pchar(alldomain[i]);
lpcomment :=nil;
lpprovider :=nil;
end;
ErrCode:=WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY,RESOURCEUSAGE_CONTAINER,@netres[0],EnumHandle);
if errcode=NO_ERROR then
begin
EnumEntries:=1024;
BufferSize:=SizeOf(NetRes);
ErrCode:=WNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],BufferSize);
end;
a:=0;
while (string(netres[a].lpprovider)<>'') and (errcode=NO_ERROR) do
begin
mylistitem :=mylistitems.Add ;
mylistitem.ImageIndex :=0;
mylistitem.Caption :=uppercase(stringreplace(string(NetRes[a].lpremotename),'\','',[rfReplaceAll]));
a:=a+1;
end;
wnetcloseenum(enumhandle);
end;
end;

◇[DELPHI]获取某一计算机上的共享目录
procedure getsharefolder(const computername:string);
var
errcode,a:integer;
netres:array[0..1023] of netresource;
enumhandle:thandle;
enumentries,buffersize:dword;
s:string;
mylistitems:tlistitems;
mylistitem:tlistitem;
mystrings:tstringlist;
begin
with netres[0] do begin
dwscope :=RESOURCE_GLOBALNET;
dwtype :=RESOURCETYPE_DISK;
dwdisplaytype :=RESOURCEDISPLAYTYPE_SHARE;
dwusage :=RESOURCEUSAGE_CONTAINER;
lplocalname :=nil;
lpremotename :=pchar(computername);
lpcomment :=nil;
lpprovider :=nil;
end; // 获取根结点
errcode:=wnetopenenum(RESOURCE_GLOBALNET,RESOURCETYPE_DISK,RESOURCEUSAGE_CONTAINER,@netres[0],enumhandle);
if errcode=NO_ERROR then
begin
EnumEntries:=1024;
BufferSize:=SizeOf(NetRes);
ErrCode:=WNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],BufferSize);
end;
wnetcloseenum(enumhandle);
a:=0;
mylistitems:=controlcenter.lstfile.Items ;
mylistitems.Clear ;
while (string(netres[a].lpprovider)<>'') and (errcode=NO_ERROR) do
begin
with mylistitems do
begin
mylistitem:=add;
mylistitem.ImageIndex :=4;
mylistitem.Caption :=extractfilename(netres[a].lpremotename);
end;
a:=a+1;
end;
end;

◇[DELPHI]得到硬盘序列号
var SerialNum : pdword; a, b : dword; Buffer : array [0..255] of char;
begin
if GetVolumeInformation('c:\', Buffer, SizeOf(Buffer), SerialNum, a, b, nil, 0) then Label1.Caption := IntToStr(SerialNum^);
end;

◇[DELPHI]MEMO的自动翻页
Procedure ScrollMemo(Memo : TMemo; Direction : char);
begin
case direction of
'd': begin
SendMessage(Memo.Handle, { HWND of the Memo Control }
WM_VSCROLL, { Windows Message }
SB_PAGEDOWN, { Scroll Command }
0) { Not Used }
end;
'u' : begin
SendMessage(Memo.Handle, { HWND of the Memo Control }
WM_VSCROLL, { Windows Message }
SB_PAGEUP, { Scroll Command }
0); { Not Used }
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ScrollMemo(Memo1,'d'); //上翻页
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ScrollMemo(Memo1,'u'); //下翻页
end;

◇[DELPHI]DBGrid中回车到下个位置(Tab键)
procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
if DBGrid1.Columns.Grid.SelectedIndex < DBGrid1.Columns.Count - 1 then
DBGrid1.Columns[DBGrid1.Columns.grid.SelectedIndex + 1].Field.FocusControl
else
begin
Table1.next;
DBGrid1.Columns[0].field.FocusControl;
end;
end;

◇[DELPHI]如何安装控件
安装方法:
1.对于单个控件,Component-->install component..-->PAS或DCU文件-->install
2.对于带*.dpk文件的控件包,File-->open(下拉列表框中选*.dpk)-->install即可.
3.对于带*.dpl文件的控件包,Install Packages-->Add-->dpl文件名即可。
4.如果以上Install按钮为失效的话,试试Compile按钮。
5.是run time lib则在option下的packages下的runtimepackes加之.
如果编译时提示文件找不到的话,一般是控件的安装目录不在delphi的Lib目录中,有两种方法可以解决:
1.把安装的原文件拷入到delphi的Lib目录下。
2.或者Tools-->Environment Options中把控件原代码路径加入到Delphi的Lib目录中即可。

◇[DELPHI]目录完全删除(deltree)
procedure TForm1.DeleteDirectory(strDir:String);
var
sr: TSearchRec;
FileAttrs: Integer;
strfilename:string;
strPth:string;
begin
strpth:=Getcurrentdir();
FileAttrs := faAnyFile;
if FindFirst(strpth+'\'+strdir+'\*.*', FileAttrs, sr) = 0 then
begin
if (sr.Attr and FileAttrs) = sr.Attr then
begin
strfilename:=sr.Name;
if fileexists(strpth+'\'+strdir+'\'+strfilename) then
deletefile(strpth+'\'+strdir+'\'+strfilename);
end;
while FindNext(sr) = 0 do
begin
if (sr.Attr and FileAttrs) = sr.Attr then
begin
strfilename:=sr.name;
if fileexists(strpth+'\'+strdir+'\'+strfilename) then
deletefile(strpth+'\'+strdir+'\'+strfilename);
end;
end;
FindClose(sr);
removedir(strpth+'\'+strdir);
end;
end;

◇[DELPHI]取得TMemo 控件当前光标的行和列信息到Tpoint中
1.function ReadCursorPos(SourceMemo: TMemo): TPoint;
var Point: TPoint;
begin
 point.y := SendMessage(SourceMemo.Handle,EM_LINEFROMCHAR,SourceMemo.SelStart,0);
 point.x := SourceMemo.SelStart-SendMessage(SourceMemo.Handle,EM_LINEINDEX,point.y,0);
 Result := Point;
end;
2.LineLength:=SendMessage(memol.handle,EM-LINELENGTH,Cpos,0);//行长

◇[DELPHI]读硬盘序列号
function GetDiskSerial(DiskChar: Char): string;
var
SerialNum : pdword;
a, b : dword;
Buffer : array [0..255] of char;
begin
result := "";
if GetVolumeInformation(PChar(diskchar+":\"), Buffer, SizeOf(Buffer), SerialNum,
a, b, nil, 0) then
 Result := IntToStr(SerialNum^);
end;

◇[INTERNET]CSS常用综合技巧
1。P:first-letter { font-size: 300%; float: left }//首字会比普通字体加大三倍。
2。//连接一个外部样式表
3。嵌入一个样式表
4。 //内联样式
Arial//SPAN接受STYLE、CLASS和ID属性

DIV可以包含段落、标题、表格甚至其它部分

5。CLASS属性
//定义见3。
6。ID属性
//定义见3。
7。属性列表
字体风格:font-style: [normal | italic | oblique];
字体大小:font-size: [xx-small | x-small | small | medium | large | x-large | xx-large | larger | smaller | <长度> | <百分比>]
文本修饰:text-decoration:[ underline || overline || line-through || blink ]
文本转换:text-transform:[none | capitalize | uppercase | lowercase]
背景颜色:background-color:[<颜色> | transparent]
背景图象:background-image:[ | none]
行高:line-height: [normal | <数字> | <长度> | <百分比>]
边框样式:border-style: [ none | dotted | dashed | solid | double | groove | ridge | inset | outset ]
漂浮:float: [left | right | none]
8。长度单位
相对单位:
em (em,元素的字体的高度)
ex (x-height,字母 "x" 的高度)
px (像素,相对于屏幕的分辨率)
绝对长度:
in (英寸,1英寸=2.54厘米)
cm (厘米,1厘米=10毫米)
mm (米)
pt (点,1点=1/72英寸)
pc (帕,1帕=12点)

◇[DELPHI]VCL制作简要步骤
1.创建部件属性方法事件
(建立库单元,继承为新的类型,添加属性、方法、事件,注册部件,建立包文件)
2.消息处理
3.异常处理
4.部件可视

◇[DELPHI]动态连接库的装载
静态装载:procedure name;external 'lib.dll';
动态装载:var handle:Thandle;
handle:=loadlibrary('lib.dll');
if handle<>0 then
begin
{dosomething}
freelibrary(handle);
end;

◇[DELPHI]指针变量和地址
var x,y:integer;p:^integer;//指向INTEGER变量的指针
x:=10;//变量赋值
p:=@x;//变量x的地址
y:=p^;//为Y赋值指针P
@@procedure//返回过程变量的内存地址

◇[DELPHI]判断字符是汉字的一个字符
ByteType('你好haha吗',1) = mbLeadByte//是第一个字符
ByteType('你好haha吗',2) = mbTrailByte//是第二个字符
ByteType('你好haha吗',5) = mbSingleByte//不是中文字符

◇[DELPHI]memo的定位操作
memo1.lines.delete(0)//删除第1行
memo1.selstart:=10//定位10字节处

◇[DELPHI]获得双字节字符内码
function getit(s: string): integer;
begin
Result := byte(s[1]) * 0 + byte(s[2]);
end;
使用:getit('计')//$bcc6 即十进制 48326

◇[DELPHI]调用ADD数据存储过程
存储过程如下:
create procedure addrecord(
record1 varchar(10)
record2 varchar(20)
)
as
begin
insert into tablename (field1,field2) values(:record1,:record2)
end
执行存储过程:
EXECUTE procedure addrecord("urrecord1","urrecord2")

◇[DELPHI]将文件存到blob字段中
function blobcontenttostring(const filename: string):string;
begin
with tfilestream.create(filename,fmopenread) do
try
setlength(Result,size);
read(Pointer(Result)^,size);
finally
free;
end;
end;
//保存字段
begin
if (opendialog1.execute) then
begin
sFileName:=OpenDialog1.FileName;
adotable1.edit;
adotable1.fieldbyname('visio').asstring:=Blobcontenttostring(FileName);
adotable1.post;
end;

◇[DELPHI]把文件全部复制到剪贴板
uses shlobj,activex,clipbrd;
procedure Tform1.copytoclipbrd(var FileName:string);
var
FE:TFormatEtc;
Medium: TStgMedium;
dropfiles:PDropFiles;
pFile:PChar;
begin
FE.cfFormat := CF_HDROP;
FE.dwAspect := DVASPECT_CONTENT;
FE.tymed := TYMED_HGLOBAL;
Medium.hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_ZEROINIT, SizeOf(TDropFiles)+length(FileName)+1);
if Medium.hGlobal<>0 then begin
Medium.tymed := TYMED_HGLOBAL;
dropfiles := GlobalLock(Medium.hGlobal);
try
dropfiles^.pfiles := SizeOf(TDropFiles);
dropfiles^.fwide := False;
longint(pFile) := longint(dropfiles)+SizeOf(TDropFiles);
StrPCopy(pFile,FileName);
Inc(pFile, Length(FileName)+1);
pFile^ := #0;
finally
GlobalUnlock(Medium.hGlobal);
end;
Clipboard.SetAsHandle(CF_HDROP,Medium.hGlobal);
end;
end;

◇[DELPHI]列举当前系统运行进程
uses TLHelp32;
procedure TForm1.Button1Click(Sender: TObject);
var lppe: TProcessEntry32;
found : boolean;
Hand : THandle;
begin
Hand := CreateToolhelp32Snapshot(TH32CS_SNAPALL,0);
found := Process32First(Hand,lppe);
while found do
begin
ListBox1.Items.Add(StrPas(lppe.szExeFile));
found := Process32Next(Hand,lppe);
end;
end;

◇[DELPHI]根据BDETable1建立新表Table2
Table2:=TTable.Create(nil);
try
Table2.DatabaseName:=Table1.DatabaseName;
Table2.FieldDefs.Assign(Table1.FieldDefs);
Table2.IndexDefs.Assign(Table1.IndexDefs);
Table2.TableName:='new_table';
Table2.CreateTable();
finally
Table2.Free();
end;

◇[DELPHI]最菜理解DLL建立和引用
//先看DLL source(FILE-->NEW-->DLL)
library project1;
uses
SysUtils, Classes;
function addit(f:integer;s:integer):integer;export;
begin
makeasum:=f+s;
end;
exports
addit;
end.
//调用(IN ur PROJECT)
implementation
function addit(f:integer;s:integer):integer;far;external 'project1';//申明
{调用就是addit(2,4);结果显示6}

◇[DELPHI]动态读取程序自身大小
function GesSelfSize: integer;
var
f: file of byte;
begin
filemode := 0;
assignfile(f, application.exename);
reset(f);
Result := filesize(f);//单位是字节
closefile(f);
end;

◇[DELPHI]读取BIOS信息
with Memo1.Lines do
begin
Add('MainBoardBiosName:'+^I+string(Pchar(Ptr($FE061))));
Add('MainBoardBiosCopyRight:'+^I+string(Pchar(Ptr($FE091))));
Add('MainBoardBiosDate:'+^I+string(Pchar(Ptr($FFFF5))));
Add('MainBoardBiosSerialNo:'+^I+string(Pchar(Ptr($FEC71))));
end;

◇[DELPHI]动态建立MSSQL别名
procedure TForm1.Button1Click(Sender: TObject);
var MyList: TStringList;
begin
MyList := TStringList.Create;
try
with MyList do
begin
Add('SERVER NAME=210.242.86.2');
Add('DATABASE NAME=db');
Add('USER NAME=sa');
end;
Session1.AddAlias('TESTSQL', 'MSSQL', MyList); //ミMSSQL
Session1.SaveConfigFile;
finally
MyList.Free;
Session1.Active:=True;
Database1.DatabaseName:='DB';
Database1.AliasName:='TESTSQL';
Database1.LoginPrompt:=False;
Database1.Params.Add('USER NAME=sa');
Database1.Params.Add('PASSWORD=');
Database1.Connected:=True;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Database1.Connected:=False;
Session1.DeleteAlias('TESTSQL'); 
end;

◇[DELPHI]播放背景音乐
uses mmsystem
//播放音乐
MCISendString('OPEN e:.MID TYPE SEQUENCER ALIAS NN', '', 0, 0);
MCISendString('PLAY NN FROM 0', '', 0, 0);
MCISendString('CLOSE ANIMATION', '', 0, 0);
end;
//停止播放
MCISendString('OPEN e:.MID TYPE SEQUENCER ALIAS NN', '', 0, 0);
MCISendString('STOP NN', '', 0, 0);
MCISendString('CLOSE ANIMATION', '', 0, 0);

◇[DELPHI]接口和类的一个范例代码
Type{接口和类申明:区别在于不能在接口中申明数据成员、任何非公有的方法、公共方法不使用PUBLIC关键字}
Isample=interface//定义Isample接口
function getstring:string;
end;
Tsample=class(TInterfacedObject,Isample)
public
function getstring:string;
end;
//function定义
function Tsample.getstring:string;
begin
result:='what show is ';
end;
//调用类对象
var sample:Tsample;
begin
sample:=Tsample.create;
showmessage(sample.getstring+'class object!');
sample.free;
end;
//调用接口
var sampleinterface:Isample;
sample:Tsample;
begin
sample:=Tsample.create;
sampleInterface:=sample;//Interface的实现必须使用class
{以上两行也可表达成sampleInterface:=Tsample.create;}
showmessage(sampleInterface.getstring+'Interface!');
//sample.free;{和局部类不同,Interface中的类自动释放}
sampleInterface:=nil;{释放接口对象}
end;

◇[DELPHI]任务条就看不当程序
var
ExtendedStyle : Integer;
begin
Application.Initialize;
ExtendedStyle := GetWindowLong (Application.Handle, GWL_EXSTYLE);
SetWindowLong(Application.Handle, GWL_EXSTYLE, ExtendedStyle OR WS_EX_TOOLWINDOW AND NOT WS_EX_APPWINDOW);
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

◇[DELPHI]ALT+CTRL+DEL看不到程序
在implementation后添加声明:
function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
RegisterServiceProcess(GetCurrentProcessID, 1);//隐藏
RegisterServiceProcess(GetCurrentProcessID, 0);//显示

◇[DELPHI]检测光驱符号
var drive:char;
cdromID:integer;
begin
for drive:='d' to 'z' do
begin
cdromID:=GetDriveType(pchar(drive+':\'));
if cdromID=5 then showmessage('你的光驱为:'+drive+'盘!');
end;
end;

◇[DELPHI]检测声卡
if auxGetNumDevs()<=0 then showmessage('No soundcard found!') else showmessage('Any soundcard found!');

◇[DELPHI]在字符串网格中画图
StringGrid.OnDrawCell事件
with StringGrid1.Canvas do
Draw(Rect.Left, Rect.Top, Image1.Picture.Graphic);

◇[SQL SERVER]SQL中代替Like语句的另一种写法
比如查找用户名包含有"c"的所有用户, 可以用
use mydatabase
select * from table1 where username like'%c%"
下面是完成上面功能的另一种写法:
use mydatabase
select * from table1 where charindex('c',username)>0
这种方法理论上比上一种方法多了一个判断语句,即>0, 但这个判断过程是最快的, 我想信80%以上的运算都是花在查找字
符串及其它的运算上, 所以运用charindex函数也没什么大不了. 用这种方法也有好处, 那就是对%,|等在不能直接用like
查找到的字符中可以直接在这charindex中运用, 如下:
use mydatabase
select * from table1 where charindex('%',username)>0
也可以写成:
use mydatabase
select * from table1 where charindex(char(37),username)>0
ASCII的字符即为%

◇[DELPHI]SQL显示多数据库/表
SELECT DISTINCT A.bianhao,a.xingming, b.gongzi FROM "jianjie.dbf" a, "gongzi.DBF" b
WHERE A.bianhao=b.bianhao

◇[DELPHI]RFC(Request For Comment)相关
IETF(Internet Engineering Task Force)维护RFC文档http://www.ietf.cnri.reston.va.us
RFC882:报文头标结构
RFC1521:MIME第一部分,传输报文方法
RFC1945:多媒体文档传输文档

◇[DELPHI]TNMUUProcessor的使用
var inStream,outStream:TFileStream;
begin
inStream:=TFileStream.create(infile.txt,fmOpenRead);
outStream:=TFileStream(outfile.txt,fmCreate);
NMUUE.Method:=uuCode;{UUEncode/Decode}
//NMUUE.Method:=uuMIME;{MIME}
NMUUE.InputStream:=InStream;
NMUUE.OutputStream:=OutStream;
NMUUE.Encode;{编码处理}
//NMUUE.Decode;{解码处理}
inStream.free;
outStream.free;
end;

◇[DELPHI]TFileStream的操作
//从文件流当前位置读count字节到缓冲区BUFFER
function read(var buffer;count:longint):longint;override;
//将缓冲区BUFFER读到文件流中
function write(const buffer;count:longint):longint;override;
//设置文件流当前读写指针为OFFSET
function seek(offset:longint;origin:word):longint;override;
origin={soFromBeginning,soFromCurrent,soFromEnd}
//从另一文件流中当前位置复制COUNT到当前文件流当前位置
function copyfrom(source:TStream;count:longint):longint;
//读指定文件到文件流
var myFStream:TFileStream;
begin
myFStream:=TFileStream.create(OpenDialog1.filename,fmOpenRead);
end;
[JavaScript]检测是否安装IE插件Shockwave&Quicktime
var myPlugin = navigator.plugins["Shockwave"];
if (myPlugin)
document.writeln("你已经安装了 Shockwave!")
else
document.writeln("你尚未安装 Shockwave!")

var myPlugin = navigator.plugins["Quicktime"];
if (myPlugin)
document.writeln("你已经安装了Quicktime!")
else
document.writeln("你尚未安装 Quicktime!")


 
痞子 @ 2007-10-16 16:02

Delphi在这两方面都做的相当出色。在Delphi的早期版本Turbo Pascal 中就曾有流(Stream)、群(Collection)和资源(Resource)等专门用于对象式数据管理的类。在Delphi中,这些功能得到了大大的加强。Delphi将对象式数据管理类归结为Stream对象(Stream)和Filer对象(Filer),并将它们应用于可视部件类库(VCL)的方方面面。它们不仅提供了在内存、外存和Windows资源中管理对象的功能,还提供了在数据库BLOB字段中对象的功能。

  在本章中将介绍Stream对象和Filer对象的实现原理、应用方法以及在超媒体系统中的应用。这对于运用Delphi 开发高级应用是很重要的。 

20.1 流式对象的实现原理和应用

 

  Stream对象,又称流式对象,是TStream、THandleStream、TFileStream、TMemoryStream、TResourceStream和TBlobStream等的统称。它们分别代表了在各种媒介上存储数据的能力,它们将各种数据类型(包括对象和部件) 在内存、外存和数据库字段中的管理操作抽象为对象方法,并且充分利用了面向对象技术的优点,应用程序可以相当容易地在各种Stream对象中拷贝数据。

  下面介绍各种对象的数据和方法及使用方法。

 

20.1.1 TStream对象

 

  TStream对象是能在各种媒介中存储二进制数据的对象的抽象对象。从TStream 对象继承的对象用于在内存、Windows资源文件、磁盘文件和数据库字段等媒介中存储数据。

  TStream中定义了两个属性:Size和Position。它们分别以字节为单位表示的流的大小和当前指针位置。TStream中定义的方法用于在各种流中读、写和相互拷贝二进制数据。因为所有的Stream对象都是从TStream中继承来的,所以在TStream中定义的域和方法都能被Stream对象调用和访问。此外,又由于面向对象技术的动态联编功能,TStream为各种流的应用提供了统一的接口,简化了流的使用;不同Stream对象是抽象了对不同存储媒介的数据上的操作,因此,TStream的需方法为在不同媒介间的数据拷贝提供了最简捷的手段。

 

20.1.1.1 TStream的属性和方法

 

  1. Position属性 

声明:property Position: Longint;

  Position属性指明流中读写的当前偏移量。

  2. Size属性

  声明:property Size: Longint;

Size属性指明了以字节为单位的流的的大小,它是只读的。

  3. CopyFrom方法

  声明:function CopyFrom(Source: TStream; Count: Longint): Longint;

CopyFrom从Source所指定的流中拷贝Count个字节到当前流中, 并将指针从当前位置移动Count个字节数,函数返回值是实际拷贝的字节数。

  4. Read方法

  声明:function Read(var Buffer; Count: Longint): Longint; virtual; abstract;

Read方法从当前流中的当前位置起将Count个字节的内容复制到Buffer中,并把当前指针向后移动Count个字节数,函数返回值是实际读的字节数。如果返回值小于Count,这意味着读操作在读满所需字节数前指针已经到达了流的尾部。

  Read方法是抽象方法。每个后继Stream对象都要根据自己特有的有关特定存储媒介的读操作覆盖该方法。而且流的所有其它的读数据的方法(如:ReadBuffer,ReadComponent等)在完成实际的读操作时都调用了Read方法。面向对象的动态联编的优点就体现在这儿。因为后继Stream对象只需覆盖Read方法,而其它读操作(如ReadBuffer、ReadComponent等)都不需要重新定义,而且TStream还提供了统一的接口。

  5. ReadBuffer方法

  声明:procedure ReadBuffer(var Buffer; Count: Longint);

  ReadBuffer方法从流中将Count个字节复制到Buffer 中, 并将流的当前指针向后移动Count个字节。如读操作超过流的尾部,ReadBuffer方法引起EReadError异常事件。

  6. ReadComponent方法

  声明:function ReadComponent(Instance: TComponent): TComponent;

ReadComponent方法从当前流中读取由Instance所指定的部件,函数返回所读的部件。ReadComponent在读Instance及其拥有的所有对象时创建了一个Reader对象并调用它的ReadRootComponent方法。

  如果Instance为nil,ReadComponent的方法基于流中描述的部件类型信息创建部件,并返回新创建的部件。

  7. ReadComponentRes方法

  声明:function ReadComponentRes(Instance: TComponent): TComponent;

ReadComponentRes方法从流中读取Instance指定的部件,但是流的当前位置必须是由WriteComponentRes方法所写入的部件的位置。

  ReadComponentRes 首先调用ReadResHeader方法从流中读取资源头,然后调用ReadComponent方法读取Instance。如果流的当前位置不包含一个资源头。ReadResHeader将引发一个EInvalidImage异常事件。在Classes库单元中也包含一个名为ReadComponentRes的函数,该函数执行相同的操作,只不过它基于应用程序包含的资源建立自己的流。

  8. ReadResHeader方法

ReadResHeader方法从流的当前位置读取Windows资源文件头,并将流的当前位置指针移到该文件头的尾部。如果流不包含一个有效的资源文件头,ReadResHeader将引发一个EInvalidImage异常事件。

  流的ReadComponentRes方法在从资源文件中读取部件之前,会自动调用ReadResHeader方法,因此,通常程序员通常不需要自己调用它。

  9. Seek方法

  声明:function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;

Seek方法将流的当前指针移动Offset个字节,字节移动的起点由Origin指定。如果Offset是负数,Seek方法将从所描述的起点往流的头部移动。下表中列出了Origin的不同取值和它们的含义:

 

表20.1 函数Seek的参数的取值

 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

  常量       值      Seek的起点 Offset的取值

─────────────────────────────────

 SoFromBeginning 0  流的开头 正 数

 SoFromCurrent 1 流的当前位置 正数或负数

 SoFromEnd 2 流的结尾 负 数

 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

 

  10. Write方法

  在Delphi对象式管理的对象中有两类对象的方法都有称为Write的:Stream对象和Filer对象。Stream对象的Write方法将数据写进流中。Filer对象通过相关的流传递数据,在后文中会介绍这类方法。

  Stream对象的Write方法声明如下:

 

function Write(const Buffer; Count: Longint): Longint; virtual; abstract;

 

Write方法将Buffer中的Count个字节写入流中,并将当前位置指针向流的尾部移动Count个字节,函数返回写入的字节数。

  TStream的Write方法是抽象的,每个继承的Stream对象都要通过覆盖该方法来提供向特定存储媒介(内存、磁盘文件等)写数据的特定方法。流的其它所有写数据的方法(如WriteBuffer、WriteComponent)都调用Write担当实际的写操作。

  11. WriteBuffer方法

  声明:procedure WriteBuffer(const Buffer; Count: Longint);

  WriteBuffer的功能与Write相似。WriteBuffer方法调用Write来执行实际的写操作,如果流没能写所有字节,WriteBuffer会触发一个EWriteError异常事件。

  12. WriteComponent方法

  在Stream对象和Filer对象都有被称为WriteComponent的方法。Stream对象的WriteComponent方法将Instance所指定的部件和它所包含的所有部件都写入流中;Writer对象的WriteComponent将指定部件的属性值写入Writer对象的流中。

  Stream对象的WriteComponent方法声明是这样的:

procedure WriteComponent(Instance: Tcomponent);

 

  WriteComponent创建一个Writer对象,并调用Writer的WriteRootComponent方法将Instance及其拥有的对象写入流。

  13. WriteComponentRes方法

  声明:WriteComponentRes(const ResName: String; Instance: TComponent);

  WriteComponentRes方法首先往流中写入标准Windows 资源文件头,然后将Instance指定的部件写入流中。要读由WriteComponentRes写入的部件,必须调用ReadComponentRes方法。

  WriteComponentRes使用ResName传入的字符串作为资源文件头的资源名,然后调用WriteComponent方法将Instance和它拥有的部件写入流。

  14. WriteDescendant方法

  声明:procedure WriteDescendant(Instance Ancestor: TComponent);

  Stream对象的WriteDescendant方法创建一个Writer对象,然后调入该对象的WriteDescendant方法将Instance部件写入流中。Instance可以是从Ancestor部件继承的窗体,也可以是在从祖先窗体中继承的窗体中相应于祖先窗体中Ancestor部件的部件。

  15. WriteDescendantRes方法

  声明:procedure WriteDescendantRes(const ResName: String;

Instance, Ancestor: TComponent);

  WriteDescendantRes方法将Windows资源文件头写入流,并使用ResName作用资源名,然后调用WriteDescendant方法,将Instance写入流。

20.1.1.2 TStream的实现原理

  TStream对象是Stream对象的基础类,这是Stream对象的基础。为了能在不同媒介上的存储数据对象,后继的Stream对象主要是在Read和Write方法上做了改进,。因此,了解TStream是掌握Stream对象管理的核心。Borland公司虽然提供了Stream对象的接口说明文档,但对于其实现和应用方法却没有提及,笔者是从Borland Delphi 2.0 Client/Server Suite 提供的源代码和部分例子程序中掌握了流式对象技术。
下面就从TStream的属性和方法的实现开始。

 

  1. TStream属性的实现

  前面介绍过,TStream具有Position和Size两个属性,作为抽象数据类型,它抽象了在各种存储媒介中读写数据所需要经常访问的域。那么它们是怎样实现的呢?

  在自定义部件编写这一章中介绍过部件属性定义中的读写控制。Position和Size也作了读写控制。定义如下:

 

property Position: Longint read GetPosition write SetPosition;

property Size: Longint read GetSize;

 

  由上可知,Position是可读写属性,而Size是只读的。

  Position属性的实现就体现在GetPosition和SetPosition。当在程序运行过程中,任何读取Position的值和给Position赋值的操作都会自动触发私有方法GetPosition和SetPosition。两个方法的声明如下:

 

function TStream.GetPosition: Longint;

begin

Result := Seek(0, 1);

end;

 

procedure TStream.SetPosition(Pos: Longint);

begin

Seek(Pos, 0);

end;

 

在设置位置时,Delphi编译机制会自动将Position传为Pos。

  前面介绍过Seek的使用方法,第一参数是移动偏移量,第二个参数是移动的起点,返回值是移动后的指针位置。

  Size属性的实现只有读控制,完全屏蔽了写操作。读控制方法GetSize实现如下:

 

function TStream.GetSize: Longint;

var

Pos: Longint;

begin

Pos := Seek(0, 1);

Result := Seek(0, 2);

Seek(Pos, 0);

end;

 

2. TStream方法的实现

  ⑴ CopyFrom方法

  CopyFrom是Stream对象中很有用的方法,它用于在不同存储媒介中拷贝数据。例如,内存与外部文件之间、内存与数据库字段之间等。它简化了许多内存分配、文件打开和读写等的细节,将所有拷贝操作都统一到Stream对象上。

  前面曾介绍:CopyFrom方法带Source和Count两个参数并返回长整型。该方法将Count个字节的内容从Source拷贝到当前流中,如果Count值为0则拷贝所有数据。

 

function TStream.CopyFrom(Source: TStream; Count: Longint): Longint;

const

MaxBufSize = $F000;

var

BufSize, N: Integer;

Buffer: PChar;

begin

if Count = 0 then

begin

Source.Position := 0;

CouNG="ZH-CN">资源文件中的部件时调用,通常程序员不需自己调用。如果读取的不是资源文件ReadResHeader,将触发异常事件。

 

procedure TStream.ReadResHeader;

var

ReadCount: Longint;

Header: array[0..79] of Char;

begin

FillChar(Header, SizeOf(Header), 0);

ReadCount := Read(Header, SizeOf(Header) - 1);

if (Byte((@Header[0])^) = $FF) and (Word((@Header[1])^) = 10) then

Seek(StrLen(Header + 3) + 10 - ReadCount, 1)

else

raise EInvalidImage.CreateRes(SInvalidImage);

end;

 

  ReadComponentRes在Windows资源文件中读取部件,为了判断是否是资源文件,它首先调用ReadResHeader方法,然后调用ReadComponent方法读取Instance指定的部件。下面是它的实现:

 

function TStream.ReadComponentRes(Instance: TComponent): TComponent;

begin

ReadResHeader;

Result := ReadComponent(Instance);

end;

 

 与ReadComponentRes相应的写方法是WriteComponentRes,Delphi 调用这两个方法读写窗体文件(DFM文件),在后面书中会举用这两个方法读取DFM文件的例子。

  ⑷ WriteComponent和WriteDescendant方法

  Stream对象的WriteDescendant方法在实现过程中,创建了TWriter对象,然后利用TWriter的WriteDescendant方法将Instance写入流。而WriteComponent方法只是简单地调用WriteDescendant方法将Instance写入流。它们的实现如下:

  

procedure TStream.WriteComponent(Instance: TComponent);

begin

WriteDescendent(Instance, nil);

end;

 

procedure TStream.WriteDescendent(Instance, Ancestor: TComponent);

var

Writer: TWriter;
begin

 

Writer := TWriter.Create(Self, 4096);

try

Writer.WriteDescendent(Instance, Ancestor);

finally

Writer.Free;

end;

end;

 

  ⑸ WriteDescendantRes和WriteComponentRes方法

  WriteDescendantRes方法用于将部件写入Windows资源文件;而WriteComponentRes 方法只是简单地调用WriteDescendantRes方法,它们的实现如下:

 

procedure TStream.WriteComponentRes(const ResName: string; Instance:

TComponent);

begin

WriteDescendentRes(ResName, Instance, nil);

end;

 

procedure TStream.WriteDescendentRes(const ResName: string; Instance,

Ancestor: TComponent);

var

HeaderSize: Integer;

Origin, ImageSize: Longint;

Header: array[0..79] of Char;

begin

Byte((@Header[0])^) := $FF;

Word((@Header[1])^) := 10;

HeaderSize := StrLen(StrUpper(StrPLCopy(@Header[3], ResName, 63))) + 10;

Word((@Header[HeaderSize - 6])^) := 30;

Longint((@Header[HeaderSize - 4])^) := 0;

WriteBuffer(Header, HeaderSize);

Origin := Position;

WriteDescendent(Instance, Ancestor);

ImageSize := Position - Origin;

Position := Origin - 4;

WriteBuffer(ImageSize, SizeOf(Longint));

Position := Origin + ImageSize;

end;

 

  WriteCompnentRes是与ReadComponentRes相应的对象写方法,这两个方法相互配合可读取Delphi的DFM文件,从而利用Delphi系统的功能。

 

20.1.2 THandleStream对象

 

  THandleStream对象的行为特别象FileStream对象,所不同的是它通过已创建的文件句柄而不是文件名来存储流中的数据。

  THandleStream对象定义了Handle属性,该属性提供了对文件句柄的只读访问,并且Handle属性可以作为Delphi的RTL文件管理函数的参数,利用文件类函数来读写数据。THandleStream覆盖了构造函数Create,该函数带有Handle 参数,该参数指定与THandleStream对象相关的文件句柄。

 

20.1.2.1 THandleStream的属性的方法:

 

  1. Handle属性

  声明:property Handle: Integer;

Handle属性提供了对文件句柄的只读访问,该句柄由THandleStream的构造方法Create传入。因此除了用THandleStream提供的方法外,也可以用文件管理函数对句柄进行操作。实际上,THandleStream的方法在实现上也是运用文件管理函数进行实际的读写操作。

  2. Create方法

  声明:constrUCtor Create(AHandle: Integer);

  Create方法使用传入的Handle参数创建一个与特定文件句柄相联的THandleStream对象,并且将AHandle赋给流的Handle属性。

 

  3. Read、Write和Seek方法

  这三个方法是TStream的虚方法,只是在THandleStream 中覆盖了这三个方法,以实现特定媒介──文件的数据存取。后面会详细介绍这三个方法的实现。

 

20.1.2.2 THandleStream的实现原理

 

  THandleStream是从TStream继承来的,因此可以共用TStream中的属性和大多数方法。THandleStream在实现上主要是增加了一个属性Handle和覆盖了Create、Read、Write和Seek四个方法。

  1. 属性的实现

  Handle属性的实现正如Delphi大多数属性的实现那样,先在对象定义的private部分声明一个存放数据的变量FHandle,然后在定义的public部分声明属性Handle,其中属性定义的读写控制部分加上只读控制,读控制只是直接读取FHandle变量的值,其实现如下:

 

THandleStream = class(TStream)

private

FHandle: Integer;

public

property Handle: Integer read FHandle;

end;

 

2. 方法的实现

  THandleStream的Create方法,以AHandle作为参数,在方法里面只是简单的将AHandle的值赋给FHandle,其实现如下:

 

constructor THandleStream.Create(AHandle: Integer);
begin

 

FHandle := AHandle;

end;

 

  为实现针对文件的数据对象存储,THandleStream的Read、Write和Seek方法覆盖了TStream中的相应方法。它们的实现都调用了Windows的文件管理函数。

  Read方法调用FileRead函数实现文件读操作,其实现如下:

 

function THandleStream.Read(var Buffer; Count: Longint): Longint;

begin

Result := FileRead(FHandle, Buffer, Count);

if Result = -1 then Result := 0;

end;

 

  Write方法调用FileWrite函数实现文件写操作,其实现如下:

 

function THandleStream.Write(const Buffer; Count: Longint): Longint;

begin

Result := FileWrite(FHandle, Buffer, Count);

if Result = -1 then Result := 0;

end;

 

  Seek方法调用FileSeek函数实现文件指针的移动,其实现如下:

 

function THandleStream.Seek(Offset: Longint; Origin: Word): Longint;

begin

Result := FileSeek(FHandle, Offset, Origin);

end;

 

20.1.3 TFileStream对象

 

  TFileStream对象是在磁盘文件上存储数据的Stream对象。TFileStream是从THandleStream继承下来的,它和THandleStream一样都是实现文件的存取操作。不同之处在于THandleStream用句柄访问文件,而TFileStream用文件名访问文件。实际上TFileStream是THandleStream上的一层包装,其内核是THandleStream的属性和方法。

  TFileStream中没有增加新的属性和方法。它只是覆盖了的构造方法Create和析构方法Destory。在Create方法中带两个参数FileName和Mode。FileName描述要创建或打开的文件名,而Mode描述文件模式如fmCreate、fmOpenRead和fmOpenWrite等。Create方法首先使用FileCreate或FileOpen函数创建或打开名为FileName的文件,再将得到的文件句柄赋给FHandle。TFileStream的文件读写操作都是由从THandleStream继承的Read

var

Stream: TStream;

begin

Stream := TFileStream.Create(FileName, fmCreate);

try

SaveToStream(Stream);

finally

Stream.Free;

end;

end;

 

  在Delphi 的许多对象的SaveToStream 和SaveToFile、LoadFromStream和LoadFromFile方法的实现都有类似的嵌套结构。

 

20.1.5 TMemoryStream对象

 

  TMemoryStream对象是一个管理动态内存中的数据的Stream对象,它是从TCustomMemoryStream中继承下来的,除了从TCustomMemoryStream中继承的属性和方法外,它还增加和覆盖了一些用于从磁盘文件和其它注台读数据的方法。它还提供了写入、消除内存内容的动态内存管理方法。下面介绍它的这些属性和方法。

 

20.1.5.1 TMemoryStream的属性和方法

 

  1. Capacity属性

  声明:property Copacity: Longint;

Capacity属性决定了分配给内存流的内存池的大小。这与Size属性有些不同。Size属性是描述流中数据的大小。在程序中可以将Capacity 的值设置的比数据所需最大内存大一些,这样可以避免频繁地重新分配。

  2. Realloc方法

  声明:function Realloc(var NewCapacity: Longint): Pointer; virtual;

Realloc方法,以8K为单位分配动态内存,内存的大小由NewCapacity指定,函数返回指向所分配内存的指针。

  3. SetSize方法

  SetSize方法消除内存流中包含的数据,并将内存流中内存池的大小设为Size字节。如果Size为零,是SetSize方法将释放已有的内存池,并将Memory属性置为nil;否则,SetSize方法将内存池大小调整为Size。

4. Clear方法

  声明:procedure Clear;

Clear方法释放内存中的内存池,并将Memory属性置为nil。在调用Clear方法后,Size和Position属性都为0。

  5. LoadFromStream方法

  声明:procedure LoadFromStream(Stream: TStream);

LoadFromStream方法将Stream指定的流中的全部内容复制到MemoryStream中,复制过程将取代已有内容,使MemoryStream成为Stream的一份拷贝。

  6. LoadFromFile方法

  声明:procedure LoadFromFile(count FileName: String);

LoadFromFile方法将FileName指定文件的所有内容复制到MemoryStream中,并取代已有内容。调用LoadFromFile方法后,MemoryStream将成为文件内容在内存中的完整拷贝。

 

20.1.5.2 TMemoryStream对象的实现原理
TMemoryStream从TCustomMemoryStream对象直接继承,因此可以享用TCustomMemoryStream的属性和方法。前面讲过,TCustomMemoryStream是用于内存中数据操作的抽象对象,它为MemoryStream对象的实现提供了框架,框架中的内容还要由具体MemoryStream对象去填充。TMemoryStream对象就是按动态内存管理的需要填充框架中的具体内容。下面介绍TMemoryStream对象的实现。

  1. TMemoryStream属性的实现

  TMemoryStream在其protected部分增加了一个Capacity属性,该属性决定了MemoryStream所占动态内存的大小。TMemoryStream首先在private部分声明了FCapacity变量作为存储Capacity属性值的数据域,然后在protected部分声明了该属性。在属性声明的读控制部分简单读取FCapacity的值,在写控制处调用了方法SetCapacity。该方法除了给FCapacity赋值外还执行了改Capacity属性所必需操作如状态改变等。

  下面是属性的实现:

 

TMemoryStream = class(TCustomMemoryStream)

private

FCapacity: Longint;

procedure SetCapacity(NewCapacity: Longint);

protected

property Capacity: Longint read FCapacity write SetCapacity;

public

end;

 

  写控制方法SetCapacity的实现是这样的:

 

procedure TMemoryStream.SetCapacity(NewCapacity: Longint);

begin

SetPointer(Realloc(NewCapacity), FSize);

FCapacity := NewCapacity;

end;

 

  在SetCapacity 方法先是调用Realloc重新分配内存,然后用NewCapacity的值给FCapacity赋值。Realloc方法进行某些对象状态的改变。

  2. TMemoryStream对象方法的实现

  ⑴ Realloc方法

  Realloc方法是TMemoryStream动态内存分配的核心,它的SetSize、SetCapacity等方法最终都是调用Realloc进行内存的分配和初始化工作的。它的实现如下:

 

const

MemoryDelta = 00;

 

function TMemoryStream.Realloc(var NewCapacity: Longint): Pointer;

begin

if NewCapacity > 0 then

NewCapacity := (NewCapacity + (MemoryDelta - 1)) and not (MemoryDelta - 1);

Result := Memory;

if NewCapacity <> FCapacity then

begin

if NewCapacity = 0 then

begin

GlobalFreePtr(Memory);

Result := nil;

end else

begin

if Capacity = 0 then

Result := GlobalAllocPtr(HeapAllocFlags, NewCapacity)

else

Result := GlobalReallocPtr(Memory, NewCapacity, HeapAllocFlags);

if Result = nil then raise EStreamError.CreateRes(SMemoryStreamError);

end;

end;

end;

 

  Realloc方法是以8K为单位分配动态内存的,方法中的第一句if语句就是执行该操作。如果传入的NewCapacity参数值为0,则释放流中的内存。Realloc方法用GLobal FreePtr函数释放内存,用GlobalAllocPtr分配内存,用GlobalReallocPtr进行内存的重分配。如果原来的Capacity属性值为0,则调用GlobaAllocPtr否则调用GlobalReallocPtr。最后如果Result为nil则触发内存流错的异常事件,否则返回指向分配的内存的指针。

  ⑵ Write方法

  Write方法从内存流内部缓冲池的当前位置开始写入二进制数据。其实现如下:

 

function TMemoryStream.Write(const Buffer; Count: Longint): Longint;

var

Pos: Longint;

begin

if (FPosition >= 0) and (Count >= 0) then

begin

Pos := FPosition + Count;

if Pos > 0 then

begin

if Pos > FSize then

begin

if Pos > FCapacity then

SetCapacity(Pos);

FSize := Pos;

end;

System.Move(Buffer, Pointer(Longint(FMemory) + FPosition)^, Count);

FPosition := Pos;
Result := Count;

 

Exit;

end;

end;

Result := 0;

end;

 

  Buffer中存储要写入流的二进制数据,如果要写入的数据的字节超出了流的内存池的大小,则调用SetCapacity方法再分配内存,然后用内存复制函数将Buffer中的数据复制到FMemory中。接着移动位置指针,并返回写入数据的字节数。分析这段程序可以知道,FCapacity的值和FSize的值是不同的。

  ⑶ Clear方法

  Clear方法消除内存流中的数据,将Memory属性置为nil,并将FSize和FPosition 的值设为0。其实现如下:

 

procedure TMemoryStream.Clear;

begin

SetCapacity(0);

FSize := 0;

FPosition := 0;

end;

 

  ⑷ LoadFromStream和LoadFromFile方法

  LoadFromStream方法首先根据传入的Stream的Size属性值重新分配动态内存,然后调用Stream的ReadBuffer方法往FMemory中复制数据,结果Stream的全部内容在内存中有了一份完整拷贝。其实现如下:

 

procedure TMemoryStream.LoadFromStream(Stream: TStream);

var

Count: Longint;

begin

Stream.Position := 0;

Count := Stream.Size;

SetSize(Count);

if Count <> 0 then Stream.ReadBuffer(FMemory^, Count);

end; 

  LoadFromFile与LoadFromStream是一对方法。LoadFromFile首先创建了一个TFileStream对象,然后调用LoadFromStream方法,将FileStream文件流中的数据写入MemoryStream中。



 
痞子 @ 2007-10-16 15:49

大家都认为,C语言之所以强大,以及其自由性,很大部分体现在其灵活的指针运用上。因此,说指针是C语言的灵魂,一点都不为过。同时,这种说法也让很多人产生误解,似乎只有C语言的指针才能算指针。Basic不支持指针,在此不论。其实,Pascal语言本身也是支持指针的。从最初的Pascal发展至今的Object Pascal,可以说在指针运用上,丝毫不会逊色于C语言的指针。

以下内容分为八个部分,分别是

一、类型指针的定义

二、无类型指针的定义

三、指针的解除引用

四、取地址(指针赋值)

五、指针运算

六、动态内存分配

七、字符数组的运算

八、函数指针

一、类型指针的定义。对于指向特定类型的指针,在C中是这样定义的:

int *ptr;

char *ptr;

与之等价的Object Pascal是如何定义的呢?

var

ptr : ^Integer;

ptr : ^char;

其实也就是符号的差别而已。

二、无类型指针的定义。C中有void *类型,也就是可以指向任何类型数据的指针。Object Pascal为其定义了一个专门的类型:Pointer。于是,

ptr : Pointer;

就与C中的

void *ptr;

等价了。

三、指针的解除引用。要解除指针引用(即取出指针所指区域的值),C 的语法是 (*ptr),Object Pascal则是 ptr^。

四、取地址(指针赋值)。取某对象的地址并将其赋值给指针变量,C 的语法是

ptr = &Object;

Object Pascal 则是

ptr := @Object;

也只是符号的差别而已。

五、指针运算。在C中,可以对指针进行移动的运算,如:

char a[20];

char *ptr=a;

ptr++;

ptr+=2;

当执行ptr++;时,编译器会产生让ptr前进sizeof(char)步长的代码,之后,ptr将指向a[1]。ptr+=2;这句使得ptr前进两个sizeof(char)大小的步长。同样,我们来看一下Object Pascal中如何实现:

var

a : array [1..20] of Char;

ptr : PChar; //PChar 可以看作 ^Char

begin

ptr := @a;

Inc(ptr); // 这句等价于 C 的 ptr++;

Inc(ptr, 2); //这句等价于 C 的 ptr+=2;

end;

六、动态内存分配。C中,使用malloc()库函数分配内存,free()函数释放内存。如这样的代码:

int *ptr, *ptr2;

int i;

ptr = (int*) malloc(sizeof(int) * 20);

ptr2 = ptr;

for (i=0; i<20; i++){

*ptr = i;

ptr++;

}

free(ptr2);

Object Pascal中,动态分配内存的函数是GetMem(),与之对应的释放函数为FreeMem()(传统Pascal中获取内存的函数是New()和 Dispose(),但New()只能获得对象的单个实体的内存大小,无法取得连续的存放多个对象的内存块)。因此,与上面那段C的代码等价的Object Pascal的代码为:

var ptr, ptr2 : ^integer;

i : integer;

begin

GetMem(ptr, sizeof(integer) * 20);

//这句等价于C的 ptr = (int*) malloc(sizeof(int) * 20);

ptr2 := ptr; //保留原始指针位置

for i := 0 to 19 do

begin

ptr^ := i;

Inc(ptr);

end;

FreeMem(ptr2);

end;

对于以上这个例子(无论是C版本的,还是Object Pascal版本的),都要注意一个问题,就是分配内存的单位是字节(BYTE),因此在使用GetMem时,其第二个参数如果想当然的写成 20,那么就会出问题了(内存访问越界)。因为GetMem(ptr, 20);实际只分配了20个字节的内存空间,而一个整形的大小是四个字节,那么访问第五个之后的所有元素都是非法的了(对于malloc()的参数同样)。

七、字符数组的运算。C语言中,是没有字符串类型的,因此,字符串都是用字符数组来实现,于是也有一套str打头的库函数以进行字符数组的运算,如以下代码:

char str[15];

char *pstr;

strcpy(str, "teststr");

strcat(str, "_testok");

pstr = (char*) malloc(sizeof(char) * 15);

strcpy(pstr, str);

printf(pstr);

free(pstr);

而在Object Pascal中,有了String类型,因此可以很方便的对字符串进行各种运算。但是,有时我们的Pascal代码需要与C的代码交互(比如:用Object Pascal的代码调用C写的DLL或者用Object Pascal写的DLL准备允许用C写客户端的代码)的话,就不能使用String类型了,而必须使用两种语言通用的字符数组。其实,Object Pascal提供了完全相似C的一整套字符数组的运算函数,以上那段代码的Object Pascal版本是这样的:

var str : array [1..15] of char;

pstr : PChar; //Pchar 也就是 ^Char

begin

StrCopy(@str, 'teststr'); //在C中,数组的名称可以直接作为数组首地址指针来用

//但Pascal不是这样的,因此 str前要加上取地址的运算符

StrCat(@str, '_testok');

GetMem(pstr, sizeof(char) * 15);

StrCopy(pstr, @str);

Write(pstr);

FreeMem(pstr);

end;

八、函数指针。在动态调用DLL中的函数时,就会用到函数指针。假设用C写的一段代码如下:

typedef int (*PVFN)(int); //定义函数指针类型

int main()

{

HMODULE hModule = LoadLibrary("test.dll");

PVFN pvfn = NULL;

pvfn = (PVFN) GetProcAddress(hModule, "Function1");

pvfn(2);

FreeLibrary(hModule);

}

就我个人感觉来说,C语言中定义函数指针类型的typedef代码的语法有些晦涩,而同样的代码在Object Pascal中却非常易懂:

type PVFN = Function (para : Integer) : Integer;

var

fn : PVFN;

//也可以直接在此处定义,如:fn : function (para:Integer):Integer;

hm : HMODULE;

begin

hm := LoadLibrary('test.dll');

fn := GetProcAddress(hm, 'Function1');

fn(2);

FreeLibrary(hm);

end;



 
痞子 @ 2007-10-16 15:45

一、好首先看看sizeof和strlen在MSDN上的定义:

  首先看一MSDN上如何对sizeof进行定义的:
sizeof Operator
sizeof expression
The sizeof keyword gives the amount of storage, in bytes, associated with a variable or a type
(including aggregate types). This keyword returns a value of type size_t.
The expression is either an identifier or a type-cast expression (a type specifier
enclosed in parentheses).
When applied to a structure type or variable, sizeof returns the actual size, which may include
padding bytes inserted for alignment. When applied to a statically dimensioned array, sizeof
returns the size of the entire array. The sizeof operator cannot return the size of dynamically
allocated arrays or external arrays.

  然后再看一下对strlen是如何定义的:

strlen
Get the length of a string.
Routine Required Header:
strlen <string.h>
size_t strlen( const char *string );
Parameter
string:Null-terminated string
Libraries
All versions of the C run-time libraries.
Return Value
Each of these functions returns the number of characters in string, excluding the terminal
NULL. No return value is reserved to indicate an error.
Remarks
Each of these functions returns the number of characters in string, not including the
terminating null character. wcslen is a wide-character version of strlen; the argument of
wcslen is a wide-character string. wcslen and strlen behave identically otherwise.

  二、由几个例子说开去。

  第一个例子:

char* ss = "0123456789";
sizeof(ss) 结果 4 ===》ss是指向字符串常量的字符指针
sizeof(*ss) 结果 1 ===》*ss是第一个字符
char ss[] = "0123456789";
sizeof(ss) 结果 11 ===》ss是数组,计算到\\0位置,因此是10+1
sizeof(*ss) 结果 1 ===》*ss是第一个字符
char ss[100] = "0123456789";
sizeof(ss) 结果是100 ===》ss表示在内存中的大小 100×1
strlen(ss) 结果是10 ===》strlen是个函数内部实现是用一个循环计算到\\0为止之前
int ss[100] = "0123456789";
sizeof(ss) 结果 400 ===》ss表示再内存中的大小 100×4
strlen(ss) 错误 ===》strlen的参数只能是char* 且必须是以\\'\\'结尾的
char q[]="abc";
char p[]="a\\n";
sizeof(q),sizeof(p),strlen(q),strlen(p);
结果是 4 3 3 2

  第二个例子:

class X
{
int i;
int j;
char k;
};
X x;
cout<<sizeof(X)<<endl; 结果 12 ===》内存补齐
cout<<sizeof(x)<<endl; 结果 12 同上

  第三个例子:

char szPath[MAX_PATH]

  如果在函数内这样定义,那么sizeof(szPath)将会是MAX_PATH,但是将szPath作为虚参声明时(void fun(char szPath[MAX_PATH])),sizeof(szPath)却会是4(指针大小)

  三、sizeof深入理解。

  •   1.sizeof操作符的结果类型是size_t,它在头文件中typedef为unsigned int类型。该类型保证能容纳实现所建立的最大对象的字节大小。
  •   2.sizeof是算符,strlen是函数。
  •   3.sizeof可以用类型做参数,strlen只能用char*做参数,且必须是以\\'\\'\\0\\'\\'结尾的。sizeof还可以用函数做参数,比如:
    short f();
    printf("%d\\n", sizeof(f()));
    输出的结果是sizeof(short),即2。
  •   4.数组做sizeof的参数不退化,传递给strlen就退化为指针了。
  •   5.大部分编译程序 在编译的时候就把sizeof计算过了 是类型或是变量的长度这就是sizeof(x)可以用来定义数组维数的原因
    char str[20]="0123456789";
    int a=strlen(str); //a=10;
    int b=sizeof(str); //而b=20;
  •   6.strlen的结果要在运行的时候才能计算出来,时用来计算字符串的长度,不是类型占内存的大小。
  •   7.sizeof后如果是类型必须加括弧,如果是变量名可以不加括弧。这是因为sizeof是个操作符不是个函数。
  •   8.当适用了于一个结构类型时或变量, sizeof 返回实际的大小, 当适用一静态地空间数组, sizeof 归还全部数组的尺 寸。 sizeof 操作符不能返回动态地被分派了的数组或外部的数组的尺寸
  •   9.数组作为参数传给函数时传的是指针而不是数组,传递的是数组的首地址,如:
    fun(char [8])
    fun(char [])
    都等价于 fun(char *) 在C++里传递数组永远都是传递指向数组首元素的指针,编译器不知道数组的大小如果想在函数内知道数组的大小, 需要这样做:进入函数后用memcpy拷贝出来,长度由另一个形参传进去
    fun(unsiged char *p1, int len)
    {
    unsigned char* buf = new unsigned char[len+1]
    memcpy(buf, p1, len);
    }
      有关内容见: C++ PRIMER?
  •   10.计算结构变量的大小就必须讨论数据对齐问题。为了CPU存取的速度最快(这同CPU取数操作有关,详细的介绍可以参考一些计算机原理方面的书),C++在处理数据时经常把结构变量中的成员的大小按照4或8的倍数计算,这就叫数据对齐(data alignment)。这样做可能会浪费一些内存,但理论上速度快了。当然这样的设置会在读写一些别的应用程序生成的数据文件或交换数据时带来不便。MS VC++中的对齐设定,有时候sizeof得到的与实际不等。一般在VC++中加上#pragma pack(n)的设定即可.或者如果要按字节存储,而不进行数据对齐,可以在Options对话框中修改Advanced compiler页中的Data alignment为按字节对齐。
  • 11.sizeof操作符不能用于函数类型,不完全类型或位字段。不完全类型指具有未知存储大小的数据类型,如未知存储大小的数组类型、未知内容的结构或联合类型、void类型等。如sizeof(max)若此时变量max定义为int max(),sizeof(char_v) 若此时char_v定义为char char_v [MAX]且MAX未知,sizeof(void)都不是正确形式

  四、结束语

  sizeof使用场合。

  •   1.sizeof操作符的一个主要用途是与存储分配和I/O系统那样的例程进行通信。例如: 
      void *malloc(size_t size), 
      size_t fread(void * ptr,size_t size,size_t nmemb,FILE * stream)。
  •   2.用它可以看看一类型的对象在内存中所占的单元字节。
    void * memset(void * s,int c,sizeof(s))
  •   3.在动态分配一对象时,可以让系统知道要分配多少内存。
  •   4.便于一些类型的扩充,在windows中就有很多结构内型就有一个专用的字段是用来放该类型的字节大小。
  •   5.由于操作数的字节数在实现时可能出现变化,建议在涉及到操作数字节大小时用sizeof来代替常量计算。
  •   6.如果操作数是函数中的数组形参或函数类型的形参,sizeof给出其指针的大小。


 
痞子 @ 2007-09-20 17:20

Delphi是一种具有功能强大、简便易用和代码执行速度快等优点的可视化快速应用开发工具,它在构架企业信息系统方面发挥着越来越重要的作用,许多程序员愿意选择 Delphi作为开发工具编制各种应用程序。但是,美中不足之处是 Delphi没有自带的串口通信控件,在它的帮助文档里也没有提及串口通信,这就给编制通信程序的开发人员带来许多不便。
 
目前,利用 Delphi实现串口通信的常用的方法有 3种:一是利用控件,如 MSCOMM控件和 SPCOMM控件;二是使用 API函数;三是调用其他串口通信程序。其中利用 API编写串口通信程序较为复杂,需要掌握大量的通信知识。相比较而言,利用 SPCOMM控件则相对较简单,并且该控件具有丰富的与串口通信密切相关的属性及事件,提供了对串口的各种操作,而且还支持多线程。下面本文结合实例详细介绍 SPCOMM控件的使用。
 
SPCOMM的安装
 
1.选择下拉菜单 Component中的 Install Component选项,弹出如图 1所示的窗口。
 
图 1
 
在 Unit file name处填写 SPCOMM控件所在的路径,其他各项可用默认值,点击 OK按钮。
 
2.安装后,在 System控件面板中将出现一个红色控件 COM。现在就可以像 Delphi自带控件一样使用 COM控件了。
 
SPCOMM的属性、方法和事件
 
1.属性
 
●CommName:表示 COM1、 COM2等串口的名字;
 
●BaudRate:根据实际需要设定的波特率,在串口打开后也可更改此值,实际波特率随之更改;
 
●ParityCheck:表示是否需要奇偶校验;
 
●ByteSize:根据实际情况设定的字节长度;
 
●Parity:奇偶校验位;
 
●StopBits:停止位;
 
●SendDataEmpty:这是一个布尔型属性,为 true时表示发送缓存为空,或者发送队列里没有信息;为 false时表示发送缓存不为空,或者发送队列里有信息。
 
2.方法
 
●Startcomm方法用于打开串口,当打开失败时通常会报错。错误主要有 7种:⑴串口已经打开;⑵打开串口错误;⑶文件句柄不是通信句柄;⑷不能够安装通信缓存;⑸不能产生事件;⑹不能产生读进程;⑺不能产生写进程;
 
●StopComm方法用于关闭串口,没有返回值;
 
●WriteCommData(pDataToWrite: PChar;dwSizeofDataToWrite:Word )方法是个带有布尔型返回值的函数,用于将一个字符串发送到写进程,发送成功返回 true,发送失败返回 false。执行此函数将立即得到返回值,发送操作随后执行。该函数有两个参数,其中 pDataToWrite是要发送的字符串, dwSizeofDataToWrite是发送字符串的长度。
 
3.事件
 
●OnReceiveData :procedure (Sender: TObject;Buffer: Pointer;BufferLength: Word) of object
 
当有数据输入缓存时将触发该事件,在这里可以对从串口收到的数据进行处理。 Buffer中是收到的数据, BufferLength是收到的数据长度。
 
●OnReceiveError : procedure(Sender: TObject; EventMask : DWORD)
 
当接收数据出现错误时将触发该事件。
 
SPCOMM的使用
 
下面是一个利用 SPCOMM控件的串口通信的例子。
 
以实现 PC机与单片机 8051之间的通信为例,首先要调通它们之间的握手信号。假定它们之间的通信协议是: PC到 8051一帧数据 6个字节, 8051到 PC一帧数据也为 6个字节。当 PC发出( F0,01,FF,FF,01,F0)后 8051能收到一帧( F0,01,FF,FF,01,F0),表示数据通信握手成功,两者之间就可以按照协议相互传输数据。
 
创建一个新的工程 COMM.DPR,把窗体的 NAME属性定为 FCOMM,把窗体的标题定义为测试通信,按照图 2添加控件 (图 2中黑色矩形围住的控件即为 COMM1)。
 
 
图 2
 
1.设定 COMM1属性:
 
●波特率: 4800;
 
●奇偶校验位:无;
 
●字节长度: 8;
 
●停止位: 1;
 
●串口: COM1。
 
Memo1中将显示发送和接收的数据。将新的窗体存储为 Comm.pas。
 
2.编写源代码
 
//变量说明
 
var
 
fcomm: TFCOMM;
 
viewstring:string;
 
i:integer;
 
rbuf,sbuf:array[16] of byte;
 
//打开串口
 
procedure TFCOMM.FormShow(Sender: TObject);
 
begin
 
comm1.StartComm;
 
end;
 
//关闭串口
 
procedure TFCOMM.FormClose(Sender: TObject; var Action: TCloseAction);
 
begin
 
comm1.StopComm;
 
end;
 
//自定义发送数据过程
 
procedure senddata;
 
var
 
i:integer;
 
commflg:boolean;
 
begin
 
viewstring:=‘’ ;
 
commflg:=true;
 
for i:=1 to 6 do
 
begin
 
if not fcomm.comm1.writecommdata(@sbuf[i],1) then
 
begin
 
commflg:=false;
 
break;
 
end;
 
//发送时字节间的延时
 
sleep(2);
 
viewstring:=viewstring+ inttohex(sbuf[i],2)+‘’ ; end;
 
viewstring:=‘发送’+ viewstring;
 
fcomm.memo1.lines.add(viewstring);
 
fcomm.memo1.lines.add(‘’ );
 
if not commflg then messagedlg(‘发送失败 !’ ,mterror,[mbyes],0);
 
end;
 
//发送按钮的点击事件
 
procedure TFCOMM.Btn_sendClick(Sender: TObject);
 
begin
 
sbuf[1]:=byte($ f0); //帧头
 
sbuf[2]:=byte($ 01); //命令号
 
sbuf[3]:=byte($ ff);
 
sbuf[4]:=byte($ ff);
 
sbuf[5]:=byte($ 01);
 
sbuf[6]:=byte($ f0); //帧尾
 
senddata;//调用发送函数
 
end;
 
//接收过程
 
procedure TFCOMM.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;BufferLength: Word);
 
var
 
i:integer;
 
begin
 
viewstring:=‘’ ;
 
move(buffer^,pchar(@rbuf^),bufferlength);
 
for i:=1 to bufferlength do
 
viewstring:=viewstring+ inttohex(rbuf[i],2)+‘’ ;
 
viewstring:=‘接收’+ viewstring;
 
memo1.lines.add(viewstring);
 
memo1.lines.add(‘’ );
 
end;
 
如果 memo1上显示发送 F0 01 FF FF 01 F0和接收到 F0 01 FF FF 01 F0,这表示串口已正确地发送出数据并正确地接收到数据,则串口通信成功。


 
痞子 @ 2007-09-20 16:38

数据采集技术在工业控制及自动化等领域中发挥着重要的作用。数据采集的一般过程是这样的:

①向采集卡发出通道选择指令。②选择要采集的通道号。③启动A/D转换。④等待,直到转换完成。⑤从采集卡读出数据。对于多通道的采集,在程序的设计中,一般采用的两种方法。查询法或中断法。所谓查询方法就是采用一个循环,依次采集各个数据通道。查询法的优点是程序简单,易于实现;缺点是采集过程中,CPU多数时间是在等待,造成资源的浪费。中断法是采用硬件中断的形式&#0;&#0;先启动A/D转换,在转换结束时发出一中断信号&#0;&#0;CPU响应采集卡的中断时读出所采集的数据。这样,在等待转换的时间里,CPU可以进行其他的计算工作,而不用处于等待状态。中断法的优点是资源能充分利用;但是程序设计复杂,尤其是当系统的硬件中断资源紧张时,很容易造成中断冲突;另外,在Windows或Win95等操作系统中,不允许用户安装中断处理程序时,则无法实现。

 

---- 以上讨论的两种方法都是在DOS下的方法;在Win95下,现在有了一个更好的方法&#0;&#0;多线程技术。现在,我们可以利用多线程技术来进行数据采集。

 

---- 1. 采用多线程进行数据采集的优点

 

---- Win95/98最让人喜爱的除了漂亮的界面以外,就是多线程与多任务了。DOS环境中,执行中的程序可以独占全部的资源;在Windows环境中,虽然它是一个略具雏形的多任务环境,但是只要你喜欢,你的程序仍然可以掌握所有的CPU时间。但是,在Windows95以及Windows NT中,一个程序无法独占所有的CPU执行时间。而且,一个程序也不是从头到尾一条线。相反,一个程序在执行中可以分为多个程序片段,同时执行。这些能同时执行的程序片段称为线程。在Windows 95以及Windows NT中,操作系统同一时间可以轮流执行多个程序,这就是多任务。

 

---- 采用多线程进行数据采集可以有效地加快程序的反应速度、增加执行的效率。一般的程序中都要处理用户的输入,但用户的输入速度与CPU的执行速度相比就向走路与做飞机一样。这样,CPU就将浪费大量的时间用来等待用户的输入(如在DOS环境中)。如果采用多线程,那么就可以用一个线程等待用户的输入;另一个线程进行数据处理或其他的工作。对于数据采集程序,可以用一个单独的线程进行数据采集。这样,能最大限度的保证采集的实时性,而另外的线程同时又能及时地响应用户的操作或进行数据处理。否则,程序在采集数据时就不能响应用户的操作;在响应用户操作时就不能进行数据采集。尤其当采集的数据量很大,数据处理任务很重时,如果不采用多线程,采集时的漫长的等待是很让人接受的。

 

---- 但是,多线程要比普通程序设计复杂得多。由于任一时刻都可能有多个线程同时执行,所以,许多的变量、数据都可能会被其他线程所修改。这就是多线程程序中最关键的线程间的同步控制问题。

 

---- 2. 多线程进行数据采集应解决的问题

 

---- 其实,多线程程序设计复杂是暂时的;如果,你采用传统的C进行多线程的设计,那么你必须自己控制线程间的同步。那将是很复杂的。但是,如果利用面向对象的设计方法,采用Delphi进行多线程程序设计,问题就简单多了。这是因为,Delphi已将多线程的复杂性替我们处理了,我们所要做的就是继承。

 

---- 具体地说,多线程数据采集需要完成以下工作:

 

---- ① 从TThread类派生一个自己的类SampleThread。这就是我们用于数据采集的类。进行采集时,只需要简单地创建一个SampleThread的实例。

 

---- ② 重载超类TThread的Execute方法。在这一方法中将具体地执行数据采集任务。

 

---- ③ 如果希望一边采集一边显示,就在编写几个用于显示采集进度的过程,供Execute方法调用。

 

---- TThread类中最常用的属性/方法如下:

 

Create方法:constructor Create

(CreateSuspended: Boolean);

 

---- 其中CreateSuspended参数确定线程在创建时是否立即执行。如果为True,新线程在创建后被挂起;如果为False,线程在创建后立即执行。

 

FreeOnTerminate属性:

property FreeOnTerminate: Boolean;

 

---- 该属性确定程序员是否负责撤消该线程。如果该属性为True,VCL将在该线程终止时自动撤消线程对象。它的缺省值为False。

 

OnTerminate属性:

property OnTerminate: TNotifyEvent;

 

---- 该属性指定一个当线程终止时发生的事件。

 

---- 下面看一个具体的例子:

 

---- 3. 多线程数据采集的实现

 

---- 这是笔者开发的一个测抽油机功图的程序。它的功能是采集抽油机悬点的载荷及位移数据,经过处理后做出抽油机的功图。图1(略)所示是数据采集时的界面。点“采集数据”按钮后,程序将创建一新的线程,并设置其属性。这一新线程将完成数据采集任务。程序如下:

 

Procedure TsampleForm.

DoSampleBtnClick(Sender: TObject);

Begin

ReDrawBtn.Enabled := True;

DoSampleBtn.Enabled := False;

FFTBtn.Enabled := True;

TheSampler := SampleThread.Create(False);

创建采集线程

TheSampler.OnTerminate := FFTBtnClick;

采集完成后要执行的任务

TheSampler.FreeOnTerminate := True;

采集完成后撤消

End;

 

---- 采集线程的类定义如下:

 

Type

SampleThread = class(TThread)

Public

function AdRead(ach: byte): integer; safecall;

读A/D卡的函数

procedure UpdateCaption;

显示采集所用时间

private

{ Private declarations }

protected

thes, thep: real;

dt: real;

id: integer;

st, ed: LongInt;

procedure Execute; override;

这是关键。

End;

 

---- 在这个类中定义了一个函数AdRead用于操作A/D卡,两个过程用于显示采集的进度与所用时间。需要注意的是AdRead函数是用汇编写的,参数调用格式必须是safecall。

 

---- 关键的重载方法Execute的代码如下:

 

Procedure SampleThread.Execute;

Begin

StartTicker := GetTickCount;

id := 0;

Repeat

thes := Adread(15) * ad2mv * mv2l;

采集第15通道

thep := Adread(3) * ad2mv * mv2n;

采集第3通道

dt := GetTickCount - StartTicker;

sarray[id] := thes;

parray[id] := thep;

tarray[id] := dt;

inc(id);

Synchronize(UpdateCaption);

注意:显示采集进度

Until id >=4096;

ed := GetTickCount;

Synchronize(ShowCostTime);

注意:显示所用时间

end;

 

---- 从以上代码中可见,Execute与一般的代码并无本质区别。仅有的区别是显示采集进度和显示所用时间时,不能直接调用各自的过程,而是通过调用Synchronize间接地调用。这样作是为了保持进程间的同步。

 

---- 4. 结论

 

---- 以上的程序采用Delphi 4.0编程,在AMD-K6-2/300上实现。测试结果是这样的:采用多线程,采集4096个点一般耗用10~14s的时间;如果不采用多线程则需要1分钟到1分半。可见多线程可明显提高程序的执行效率。



 
痞子 @ 2007-09-20 15:21

(1)创建线程
MsgThread := TMsgThread.Create(False) ;    //创建并执行线程
MsgThread := TMsgThread.Create(True) ;   //创建线程后挂起
constructor Create(CreateSuspended: Boolean); 中的参数CreateSuspended表示创建后是否挂起线程。
(2)设置线程里没有设置循环执行的话,且设置FreeOnTerminate为True,则线程执行完后就会自己释放。
(3)在一个线程结束后,调用另一个事件的方法:
只要设置Onterminate:=某方法,这样在线程结束前自然会被调用,比如 :
procedure TSendShortMessageThread.Execute;
var
 Bitmap: Tbitamp;
begin
Bimap:=Tbitmap.create(nil) ;
OnTerminate:=Threaddone;
end;

procedure Threaddone(sender: tobject);
begin
Bimap.Free;   //在Destory之前会被调用
end;
(4)程序结束前安全的退出线程的方法:
     if MsgThread <> nil then
   begin
     MsgThread.Terminate ;
     MsgThread.WaitFor ;
   end;
(5)判断当前线程的状态:
//以下资料来自大富翁论坛。
/判断线程是否释放
//返回值:0-已释放;1-正在运行;2-已终止但未释放;
//3-未建立或不存在
function TFrmMain.CheckThreadFreed(aThread: TThread): Byte;
var
 i: DWord;
 IsQuit: Boolean;
begin
 if Assigned(aThread) then
 begin
   IsQuit := GetExitCodeThread(aThread.Handle, i);
   if IsQuit then           //If the function succeeds, the return value is nonzero.
                                 //If the function fails, the return value is zero.
   begin
     if i = STILL_ACTIVE then    //If the specified thread has not terminated,
                                 //the termination status returned is STILL_ACTIVE.
       Result := 1
     else
       Result := 2;              //aThread未Free,因为Tthread.Destroy中有执行语句
   end
   else
     Result := 0;                //可以用GetLastError取得错误代码
 end
 else
   Result := 3;
end;
(6)线程同步。
如果线程要调用VCL里面的内容(如:别的窗体中的控件),就需要将这个线程同步。线程同步表示交由主线程运行这段代码,各个线程都在主线程中分时间段运行。另外,要想避免多个线程同时执行同一段代码也需要将多线程同步。
临界区和互斥的作用类似,都是用来进行同步的,但它们间有以下一点差别:
临界区只能在进程内使用,也就是说只能是进程内的线程间的同步;而互斥则还可用在进程之间的;临界区所花消的时间很少,才10~15个时间片,而互斥需要400多个;临界区随着进程的终止而终止,而互斥,如果你不用closehandle()的话,在进程终止后仍然在系统内存在,也就是说它是系统全局对象;
同步的方法有:

(1)使用临界区对象。
临界区对象有两种:TRTLCriticalSection 和 CriticalSection。
  TRTLCriticalSection的用法

var
 GlobalVariable:Double;

var
 CriticalSection:TRTLCriticalSection;

procedure SetGlobalVariable(Value:Double);
begin
 EnterCriticalSection(CriticalSection);   //进入临界区
 try
   GlobalVariable:=Value;
 finally
   LeaveCriticalSection(CriticalSection);  //离开临界区
 end;
end;

initialization
 InitializeCriticalSection(CriticalSection);  //初始化
finalization
 DeleteCriticalSection(CriticalSection); //删除
end.
  CriticalSection(重要区段)的用法:
var criticalsection: TCriticalsection;
创建:criticalsection := TCriticalsection.create;
使用:
criticalsection.enter;
try
  ...
finally
  criticalsection.leave;
end;    

   (2)使用互斥
先在主线程中创建事件对象:
var
  hMutex: THandle = 0;
  ...
 hMutex := CreateMutex(nil, False, nil);

 在线程的Execute方法中加入以下代码:
if WaitForSingleObject(hMutex, INFINITE) = WAIT_OBJECT_0 then
  //Do Something;
  ...
ReleaseMutex(hMutex);

最后记得要释放互斥对象:
CloseHandle(hMutex);

(3)使用信号量

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TMyThread = class(TThread)
  private

  protected
    procedure Execute; override;
  public

    constructor Create; virtual;
  end;

var
  Form1 : TForm1;
  HSem : THandle = 0 ;
implementation

{$R *.dfm}

var
  tick: Integer = 0;
procedure TMyThread.Execute;
var
  WaitReturn : DWord ;
begin
  WaitReturn := WaitForSingleObject(HSem,INFINITE) ;
  Form1.Edit1.Text := IntToStr(tick);
  Inc(tick);
  Sleep(10);
  ReleaseSemaphore(HSem, 1, Nil)
end;

constructor TMyThread.Create;
begin
  inherited Create(False);
  FreeOnTerminate := True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  HSem := CreateSemaphore(Nil,1,1,Nil) ;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CloseHandle(HSem) ;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  index: Integer;
begin
  for index := 0 to 10 do
  begin
    TMyThread.Create;
  end;
end;

end.
一般的同步对象使用Mutex对象,是因为Mutex有一个特别之处:当一个持有对象的线程DOWN掉的时候,mutex对象可以自动让其它等待这个对象的线程接受,而其它的内核对象则不具体这个功能。
之所要使用Semaphore则是因为Semaphore可以提供一个活动线程的上限,即lMaximumCount参数,这才是它的真正有用之处。


 Delphi 多线程安全动态库 dll   src="http://blog.csdn.net/count.aspx?ID=1782020&Type=Rank">文章指数:0  CSDN Blog推出文章指数概念,文章指数是对Blog文章综合评分后推算出的,综合评分项分别是该文章的点击量,回复次数,被网摘收录数量,文章长度和文章类型;满分100,每月更新一次。

Delphi 可以快速开发桌面程序,用来做dll 封装操作,封装窗体都是很方便的。
在 delphi 做动态库时,会自动提示要 uses ShareMem,这个实际用起来是不方便的,因为 dll 可能要发布,要给其他人用,而别人用什么语言来开发是说不准的,如果不是delphi,就没办法用了。因此在接口上一般是用 pchar来代替string。但是在内部,string 还是可以拿来用的。

这样就会产生一个问题,如果动态库是支持多线程来用的,而在动态库内部并没有显式的创建一个线程时,烦繁使用 string 就说不定什么时候会产生一个内存出错。

在Delphi 内部,定义了一个 isMultiThread 的boolean 型全局变量(好象是在 system 单元)。默认这个变量是 false的。当显示地创建一个线程时(如TThread.Create),会置成true。否则一直是false。
这个变量唯一使用的地方是在 GetMem 和 FreeMem时,如果为 True,会先进入临界区,操作完成后退出。如果为false就没有临界区了。

因此在编写多线程安全的动态库时,一定要记得在动态库初始化的时候手动加上 isMultiThread=true; 这样强制delphi来使用临界区操作。

如果调用程序也是用 delphi 来写的,可能会多线程使用,那最好也在初始化的时候加上这句。值得注意的是,调用程序和动态库的这两个变量是两个互不相干的,也就是两边都得加,只在一方加上是影响不了另一方的。

其他有关多线程安全的就是一些常识了,对可能多线程访问的代码,要用事件,信号量,临界区等方法加以保护。使用方法可以参考delphi的帮助文档,或msdn,或网上的大堆文章。

 


 
痞子 @ 2007-03-20 12:59

1、限幅滤波法(又称程序判断滤波法)
    A、方法:
        根据经验判断,确定两次采样允许的最大偏差值(设为A)
        每次检测到新值时判断:
        如果本次值与上次值之差<=A,则本次值有效
        如果本次值与上次值之差>A,则本次值无效,放弃本次值,用上次值代替本次值
    B、优点:
        能有效克服因偶然因素引起的脉冲干扰
    C、缺点
        无法抑制那种周期性的干扰
        平滑度差
   
2、中位值滤波法
    A、方法:
        连续采样N次(N取奇数)
        把N次采样值按大小排列
        取中间值为本次有效值
    B、优点:
        能有效克服因偶然因素引起的波动干扰
        对温度、液位的变化缓慢的被测参数有良好的滤波效果
    C、缺点:
        对流量、速度等快速变化的参数不宜

3、算术平均滤波法
    A、方法:
        连续取N个采样值进行算术平均运算
        N值较大时:信号平滑度较高,但灵敏度较低
        N值较小时:信号平滑度较低,但灵敏度较高
        N值的选取:一般流量,N=12;压力:N=4
    B、优点:
        适用于对一般具有随机干扰的信号进行滤波
        这样信号的特点是有一个平均值,信号在某一数值范围附近上下波动
    C、缺点:
        对于测量速度较慢或要求数据计算速度较快的实时控制不适用
        比较浪费RAM
        
4、递推平均滤波法(又称滑动平均滤波法)
    A、方法:
        把连续取N个采样值看成一个队列
        队列的长度固定为N
        每次采样到一个新数据放入队尾,并扔掉原来队首的一次数据.(先进先出原则)
        把队列中的N个数据进行算术平均运算,就可获得新的滤波结果
        N值的选取:流量,N=12;压力:N=4;液面,N=4~12;温度,N=1~4
    B、优点:
        对周期性干扰有良好的抑制作用,平滑度高
        适用于高频振荡的系统    
    C、缺点:
        灵敏度低
        对偶然出现的脉冲性干扰的抑制作用较差
        不易消除由于脉冲干扰所引起的采样值偏差
        不适用于脉冲干扰比较严重的场合
        比较浪费RAM
        
5、中位值平均滤波法(又称防脉冲干扰平均滤波法)
    A、方法:
        相当于“中位值滤波法”+“算术平均滤波法”
        连续采样N个数据,去掉一个最大值和一个最小值
        然后计算N-2个数据的算术平均值
        N值的选取:3~14
    B、优点:
        融合了两种滤波法的优点
        对于偶然出现的脉冲性干扰,可消除由于脉冲干扰所引起的采样值偏差
    C、缺点:
        测量速度较慢,和算术平均滤波法一样
        比较浪费RAM


6、限幅平均滤波法
    A、方法:
        相当于“限幅滤波法”+“递推平均滤波法”
        每次采样到的新数据先进行限幅处理,
        再送入队列进行递推平均滤波处理
    B、优点:
        融合了两种滤波法的优点
        对于偶然出现的脉冲性干扰,可消除由于脉冲干扰所引起的采样值偏差
    C、缺点:
        比较浪费RAM

7、一阶滞后滤波法
    A、方法:
        取a=0~1
        本次滤波结果=(1-a)*本次采样值+a*上次滤波结果
    B、优点:
        对周期性干扰具有良好的抑制作用
        适用于波动频率较高的场合
    C、缺点:
        相位滞后,灵敏度低
        滞后程度取决于a值大小
        不能消除滤波频率高于采样频率的1/2的干扰信号
        
8、加权递推平均滤波法
    A、方法:
        是对递推平均滤波法的改进,即不同时刻的数据加以不同的权
        通常是,越接近现时刻的数据,权取得越大。
        给予新采样值的权系数越大,则灵敏度越高,但信号平滑度越低
    B、优点:
        适用于有较大纯滞后时间常数的对象
        和采样周期较短的系统
    C、缺点:
        对于纯滞后时间常数较小,采样周期较长,变化缓慢的信号
        不能迅速反应系统当前所受干扰的严重程度,滤波效果差

9、消抖滤波法
    A、方法:
        设置一个滤波计数器
        将每次采样值与当前有效值比较:
        如果采样值=当前有效值,则计数器清零
        如果采样值<>当前有效值,则计数器+1,并判断计数器是否>=上限N(溢出)
            如果计数器溢出,则将本次值替换当前有效值,并清计数器
    B、优点:
        对于变化缓慢的被测参数有较好的滤波效果,
        可避免在临界值附近控制器的反复开/关跳动或显示器上数值抖动
    C、缺点:
        对于快速变化的参数不宜
        如果在计数器溢出的那一次采样到的值恰好是干扰值,则会将干扰值当作有效值导入系统

10、限幅消抖滤波法
    A、方法:
        相当于“限幅滤波法”+“消抖滤波法”
        先限幅,后消抖
    B、优点:
        继承了“限幅”和“消抖”的优点
        改进了“消抖滤波法”中的某些缺陷,避免将干扰值导入系统
    C、缺点:
        对于快速变化的参数不宜


第11种方法:IIR 数字滤波器

A. 方法:
   确定信号带宽, 滤之。
   Y(n) = a1*Y(n-1) + a2*Y(n-2) + ... + ak*Y(n-k) + b0*X(n) + b1*X(n-1) + b2*X(n-2) + ... + bk*X(n-k)

B. 优点:高通,低通,带通,带阻任意。设计简单(用matlab)
C. 缺点:运算量大。
 

//---------------------------------------------------------------------

软件滤波的C程序样例

10种软件滤波方法的示例程序

假定从8位AD中读取数据(如果是更高位的AD可定义数据类型为int),子程序为get_ad();

1、限副滤波
/*  A值可根据实际情况调整
    value为有效值,new_value为当前采样值  
    滤波程序返回有效的实际值  */
#define A 10

char value;

char filter()
{
   char  new_value;
   new_value = get_ad();
   if ( ( new_value - value > A ) || ( value - new_value > A )
      return value;
   return new_value;
        
}

2、中位值滤波法
/*  N值可根据实际情况调整
    排序采用冒泡法*/
#define N  11

char filter()
{
   char value_buf[N];
   char count,i,j,temp;
   for ( count=0;count<N;count++)
   {
      value_buf[count] = get_ad();
      delay();
   }
   for (j=0;j<N-1;j++)
   {
      for (i=0;i<N-j;i++)
      {
         if ( value_buf>value_buf[i+1] )
         {
            temp = value_buf;
            value_buf = value_buf[i+1];
             value_buf[i+1] = temp;
         }
      }
   }
   return value_buf[(N-1)/2];
}    

3、算术平均滤波法
/*
*/

#define N 12

char filter()
{
   int  sum = 0;
   for ( count=0;count<N;count++)
   {
      sum + = get_ad();
      delay();
   }
   return (char)(sum/N);
}

4、递推平均滤波法(又称滑动平均滤波法)
/*
*/
#define N 12

char value_buf[N];
char i=0;

char filter()
{
   char count;
   int  sum=0;
   value_buf[i++] = get_ad();
   if ( i == N )   i = 0;
   for ( count=0;count<N,count++)
      sum = value_buf[count];
   return (char)(sum/N);
}

5、中位值平均滤波法(又称防脉冲干扰平均滤波法)
/*
*/
#define N 12

char filter()
{
   char count,i,j;
   char value_buf[N];
   int  sum=0;
   for  (count=0;count<N;count++)
   {
      value_buf[count] = get_ad();
      delay();
   }
   for (j=0;j<N-1;j++)
   {
      for (i=0;i<N-j;i++)
      {
         if ( value_buf>value_buf[i+1] )
         {
            temp = value_buf;
            value_buf = value_buf[i+1];
             value_buf[i+1] = temp;
         }
      }
   }
   for(count=1;count<N-1;count++)
      sum += value[count];
   return (char)(sum/(N-2));
}

6、限幅平均滤波法
/*
*/  
略 参考子程序1、3

7、一阶滞后滤波法
/* 为加快程序处理速度假定基数为100,a=0~100 */

#define a 50

char value;

char filter()
{
   char  new_value;
   new_value = get_ad();
   return (100-a)*value + a*new_value;
}

8、加权递推平均滤波法
/* coe数组为加权系数表,存在程序存储区。*/

#define N 12

char code coe[N] = {1,2,3,4,5,6,7,8,9,10,11,12};
char code sum_coe = 1+2+3+4+5+6+7+8+9+10+11+12;

char filter()
{
   char count;
   char value_buf[N];
   int  sum=0;
   for (count=0,count<N;count++)
   {
      value_buf[count] = get_ad();
      delay();
   }
   for (count=0,count<N;count++)
      sum += value_buf[count]*coe[count];
   return (char)(sum/sum_coe);
}

9、消抖滤波法

#define N 12

char filter()
{
   char count=0;
   char new_value;
   new_value = get_ad();
   while (value !=new_value);
   {
      count++;
      if (count>=N)   return new_value;
       delay();
      new_value = get_ad();
   }
   return value;    
}

10、限幅消抖滤波法
/*
*/
略 参考子程序1、9

11、IIR滤波例子

int  BandpassFilter4(int InputAD4)
{
    int  ReturnValue;
    int  ii;
    RESLO=0;
    RESHI=0;
    MACS=*PdelIn;
    OP2=1068; //FilterCoeff4[4];
    MACS=*(PdelIn+1);
    OP2=8;    //FilterCoeff4[3];
    MACS=*(PdelIn+2);
    OP2=-2001;//FilterCoeff4[2];
    MACS=*(PdelIn+3);
    OP2=8;    //FilterCoeff4[1];
    MACS=InputAD4;
    OP2=1068; //FilterCoeff4[0];
    MACS=*PdelOu;
    OP2=-7190;//FilterCoeff4[8];
    MACS=*(PdelOu+1);
    OP2=-1973; //FilterCoeff4[7];
    MACS=*(PdelOu+2);
    OP2=-19578;//FilterCoeff4[6];
    MACS=*(PdelOu+3);
    OP2=-3047; //FilterCoeff4[5];
    *p=RESLO;
    *(p+1)=RESHI;
    mytestmul<<=2;
    ReturnValue=*(p+1);
    for  (ii=0;ii<3;ii++)
    {
     DelayInput[ii]=DelayInput[ii+1];
     DelayOutput[ii]=DelayOutput[ii+1];
     }
     DelayInput[3]=InputAD4;
     DelayOutput[3]=ReturnValue;
     
   //  if (ReturnValue<0)
   //  {
   //  ReturnValue=-ReturnValue;
   //  }
    return ReturnValue;  
}