先人的DELPHI基础开发技巧2

先人的DELPHI基础开发技巧2
2011年02月28日
　　
◇[DELPHI]获取网上邻居
　　procedure getnethood();//NT做服务器，WIN98上调试通过。
　　var
　　a,i:integer;
　　errcode:integer;
　　netres:array[0..1023] of netresource;
　　enumhandle:thandle;
　　enumentries:dword;
　　b?rsize: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;
　　b?rsize:=sizeof(netres);
　　errcode:=wnetenumresource(enumhandle,enumentries,@netres[0],b?rsize);
　　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);
　　lpcomment :=nil;
　　lpprovider :=nil;
　　end;
　　ErrCode:=WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY,RESOURCEUSAGE_CONTAINER,@netres[0],EnumHandle);
　　if errcode=NO_ERROR then
　　begin
　　EnumEntries:=1024;
　　B?rSize:=SizeOf(NetRes);
　　ErrCode:=WNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],B?rSize);
　　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,b?rsize: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;
　　B?rSize:=SizeOf(NetRes);
　　ErrCode:=WNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],B?rSize);
　　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; B?r : array [0..255] of char;
　　begin
　　if GetVolumeInformation('c:\', B?r, SizeOf(B?r), 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 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;
　　B?r : array [0..255] of char;
　　begin
　　result := "";
　　if GetVolumeInformation(PChar(diskchar+":\"), B?r, SizeOf(B?r), 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 | obliq];
　　字体大小：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 | do le | 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 handle0 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]) * $100 + 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) vals(: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.hGlobal0 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:=Tr;
　　Database1.DatabaseName:='DB';
　　Database1.AliasName:='TESTSQL';
　　Database1.LoginPrompt:=False;
　　Database1.Params.Add('USER NAME=sa');
　　Database1.Params.Add('PASSWORD=');
　　Database1.Connected:=Tr;
　　end;
　　end;
　　procedure Tform1.Button2Click(Sender: TObject);
　　begin
　　Database1.Connected:=False;
　　Session1.DeleteAlias('TESTSQL'); ??
　　end;
　　◇[DELPHI]播放背景音乐
　　uses mmsystem
　　//播放音乐
　　MCISendString('OPEN e:\1.MID TYPE SEQNCER ALIAS NN', '', 0, 0);
　　MCISendString('PLAY NN FROM 0', '', 0, 0);
　　MCISendString('CLOSE ANIMATION', '', 0, 0);
　　end;
　　//停止播放
　　MCISendString('OPEN e:\1.MID TYPE SEQNCER ALIAS NN', '', 0, 0);
　　MCISendString('STOP NN', '', 0, 0);
　　MCISendString('CLOSE ANIMATION', '', 0, 0);
　　◇[DELPHI]接口和类的一个范例代码
　　Type{接口和类申明：区别在于不能在接口中申明数据成员、任何非公有的方法、公共方法不使用P LIC关键字}
　　Isample=interface//定义Isample接口
　　function getstring:string;
　　end;
　　Tsample=class(TInterfacedObject,Isample)
　　p lic
　　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
　　这种方法理论上比上一种方法多了一个判断语句,即>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(Reqst 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);
　　NMU.Method:=u ode;{Uncode/Decode}
　　//NMU.Method:=uuMIME;{MIME}
　　NMU.InputStream:=InStream;
　　NMU.OutputStream:=OutStream;
　　NMU.Encode;{编码处理}
　　//NMU.Decode;{解码处理}
　　inStream.free;
　　outStream.free;
　　end;
　　
　　
　　//从文件流当前位置读count字节到缓冲区B?R
　　function read(var b?r;count:longint):longint;override;
　　//将缓冲区B?R读到文件流中
　　function write(const b?r;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!")
　　
　　[INTERNET]表格中引用IFRAME效果
　　
　　
　　   
　　
　　
　　◇[DELPHI]WebBrowser控件技巧
　　1。实现打印功能
　　var vaIn, vaOut: OleVariant;
　　WebBrowser.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
　　2。WebBrowser从流中读取页面
　　function Tform1.LoadFromStream(const AStream: TStream): HRESULT;
　　begin
　　AStream.seek(0, 0);
　　Result := (WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(AStream));
　　end;
　　3。"about:" protocol will let you Navigate to an HTML string:
　　procedure Tform1.LoadHTMLString(sHTML: String);
　　var Flags, TargetFrameName, PostData, Headers: OleVariant;
　　WebBrowser1.Navigate('about:' + sHTML, Flags, TargetFrameName, PostData, Headers)
　　4。"res:" protocol will let you Navigate to an HTML file stored as a resource. More informations is available from the Microsoft site:
　　procedure Tform1.LoadHTMLResource;
　　var Flags, TargetFrameName, PostData, Headers: OleVariant;
　　WebBrowser1.Navigate('res://' + Application.ExeName + '/myhtml', Flags, TargetFrameName, PostData, Headers)
　　使用brcc32.exe建立资源文件 (*.rc)
　　MYHTML 23 ".\html\myhtml.htm"
　　MOREHTML 23 ".\html\morehtml.htm"
　　{$R HTML.RES} //html.rc被编译成html.res
　　5。保存完整的HTML文件
　　var
　　HTMLDocument: IHTMLDocument2;
　　Persistfile: IPersistFile;
　　begin
　　HTMLDocument := WebBrowser1.Document as IHTMLDocument2;
　　PersistFile := HTMLDocument as IPersistFile;
　　PersistFile.Save(StringToOleStr('test.htm'), Tr);
　　while HTMLDocument.readyState  'complete' do
　　Application.ProcessMessages;
　　end;
　　◇[DELPHI]安装WebBrowser控件（内嵌IE控件）
　　你必须先确定系统已安装Internet Explorer4或以后版本，DELPHI菜单--Component- - Import ActiveX Contro，列表中选择Microsoft Internet Controls"并ADD到一个已存在的包文件中，WebBrowser控件将显示在ActiveX控件面板。
　　◇[DELPHI]实现windows2000半透明窗体
　　function SetLayeredWindowAttributes(hwnd:HWND; crKey:Longint; bAlpha:byte; dwFlags:longint ):longint; stdcall; external user32;//函数声明
　　procedure Tform1.formCreate(Sender: TObject);
　　var l:longint;
　　begin
　　l:=getWindowLong(Handle, GWL_EXstyle);
　　l := l Or $80000;
　　SetWindowLong (handle, GWL_EXstyle, l);
　　SetLayeredWindowAttributes(handle, 0, 180, 2);
　　end;
　　◇[DELPHI]程序显示广告WebBrowser加载图片
　　var Flag, frame, pData, Header: OLEVariant;
　　begin
　　WebBrowser1.Navigate('http://www.chineseall.com/images/logo.jpg', flag, frame,pData, Header)
　　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]清空一个目录
　　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, Tr);
　　RemoveDirectory(PChar(TheDirectory + SearchRec.Name));
　　end
　　else begin
　　DeleteFile(PChar(TheDirectory + SearchRec.Name))
　　end;
　　end;
　　Res := FindNext(SearchRec);
　　end;
　　Result := Tr;
　　finally
　　FindClose(SearchRec.FindHandle);
　　end;
　　end;
　　◇[DELPHI]发布ADO程序之安装ADO
　　运行一次 MDac_typ.exe ，这个文件在微软的 Windows、IE、Office、Vis l St io 中都有。
　　安装程序所安装后的目录与程序中设置的目录路径一样，C:\Program Files\Common Files\System\ado文件夹中有没有ADO组件，装ACCESS2000就有ADO2.1，没有则安装MS OFfice2000，编译要去掉project->Option->Packages对话框中的Build With RunTime Library的勾。
　　◇[DELPHI]拦截Windows系统消息：WM_CLOSE消息
　　procedure WMClose(var Msg: TMessage);message WM_CLOSE;
　　procedure TMainform.WMClose(var Msg: TMessage);
　　begin
　　m_bCloseNoQry := false;
　　inherited;
　　end;
　　　
　　来自：Adnil, 时间：2002-3-26 14:54:00, ID：1003492
　　强！
　　大致看了一下，提两个修改意见：
　　◇[DELPHI]设置窗体的最大显示
　　onformCreate事件
　　self.width:=screen.width;
　　self.height:=screen.height;
　　修改：
　　self.windowstate := wsmaxmized;
　　◇[DELPHI]文件名的非法字符过滤
　　for i:=1 to length(s) do
　　if s in ['\','/',':','*','?','','|'] then
　　修改：
　　try
　　slist := tstringlist.create;
　　slist.savetofile(s);
　　result := tr;
　　deletefile(s);
　　except
　　result := false;
　　end;
　　利用异常机制，这样可以兼容linux的文件命名。
　　追加部分
　　◇[DELPHI]配置ODBC的代码
　　var
　　reg: TRegistry;
　　Driver: string;
　　begin
　　//建立和更新odbc数据源
　　//查找ODBCINST.INI键,如果sql server的驱动程序没有安装，则提示退出
　　//如果存在，则进行配置
　　reg := TRegistry.Create;
　　try
　　with reg do
　　begin
　　RootKey := HKEY_LOCAL_MACHINE;
　　if OpenKey('Software\ODBC\ODBCINST.INI\SQL Server', False) then
　　begin //如果存在sql server 驱动程序
　　Driver := ReadString('Driver');
　　CloseKey;
　　if OpenKey('Software\ODBC\ODBC.INI\ODBC Data Sources', Tr) then
　　begin //注册一个DSN名称
　　WriteString(Edit_DataSource.Text, 'SQL Server');
　　end
　　else
　　begin //创建键值失败
　　Application.MessageBox(pchar('在创建DSN' + edit_datasource.text + '时发生错误'), '创建ODBC数据源失败', MB_ICONINformATION or MB_OK);
　　exit;
　　end;
　　CloseKey;
　　//end 建立dsn
　　if OpenKey('Software\ODBC\ODBC.INI\' + Edit_DataSource.Text, Tr) then
　　begin
　　WriteString('Database', Edit_DataSource.Text);
　　WriteString('Driver', Driver);
　　WriteString('LastUser', Edit_LoginUser.Text);
　　WriteString('Server', Edit_Ip.Text);
　　end
　　else
　　begin //创建键值失败
　　Application.MessageBox(pchar('在创建DSN' + edit_datasource.text + '时发生错误'), '创建ODBC数据源失败', MB_ICONINformATION or MB_OK);
　　exit;
　　end;
　　CloseKey;
　　end
　　else
　　Application.MessageBox('在当前机器上没有安装 SQL Server的ODBC 驱动程序!，请安装相应的驱动程序', '驱动程序出错', MB_ICONINformATION or MB_OK);
　　CloseKey;
　　end;
　　finally
　　reg.Free;
　　end;
　　end;
　　◇[DELPHI]验证邮件地址有效函数
　　function IsValidEmail(const val: string): boolean;
　　function CheckAllowed(const s: string): boolean;
　　var
　　i: integer;
　　begin
　　Result:= false;
　　for i:= 1 to Length(s) do
　　begin
　　// illegal char in s -> no valid address
　　if not (s in ['a'..'z','A'..'Z','0'..'9','_','-','.']) then
　　Exit;
　　end;
　　Result:= tr;
　　end;
　　var
　　i: integer;
　　namePart, serverPart: string;
　　begin // of IsValidEmail
　　Result:= false;
　　i:= Pos('@', val);
　　if (i = 0) or (pos('..', val) > 0) then
　　Exit;
　　namePart:= Copy(val, 1, i - 1);
　　serverPart:= Copy(val, i + 1, Length(val));
　　if (Length(namePart) = 0) // @ or name missing
　　or ((Length(serverPart) = (Length(serverPart) - 2)) then
　　Exit;
　　Result:= CheckAllowed(namePart) and CheckAllowed(serverPart);
　　end;
　　◇[DELPHI]设定IE的默认打开主页
　　procedure SetStartPage(StartPage:string);
　　var
　　Reg:TRegistry;
　　begin
　　Reg:=TRegistry.Create;
　　Reg.RootKey:=HKEY_CURRENT_USER;
　　Reg.OpenKey(StartPagePath,False);
　　Reg.WriteString('Start Page',StartPage);
　　Reg.Free;
　　end;
　　◇[DELPHI]form边缘特效
　　procedure Tform1.formCreate(Sender: TObject);
　　var
　　Region1 : array of tPoint;
　　Region1hrgn : hRgn;
　　Begin
　　SetLength(Region1,59);
　　Region1[0].X:=12; Region1[0].Y:=6;
　　Region1[1].X:=484; Region1[1].Y:=6;
　　Region1[2].X:=484; Region1[2].Y:=7;
　　Region1[3].X:=486; Region1[3].Y:=7;
　　Region1[4].X:=486; Region1[4].Y:=8;
　　Region1[5].X:=487; Region1[5].Y:=8;
　　Region1[6].X:=487; Region1[6].Y:=9;
　　Region1[7].X:=488; Region1[7].Y:=9;
　　Region1.X:=488; Region1.Y:=10;
　　Region1[9].X:=489; Region1[9].Y:=10;
　　Region1[10].X:=489; Region1[10].Y:=12;
　　Region1[11].X:=490; Region1[11].Y:=12;
　　Region1[12].X:=490; Region1[12].Y:=285;
　　Region1[13].X:=489; Region1[13].Y:=285;
　　Region1[14].X:=489; Region1[14].Y:=287;
　　Region1[15].X:=488; Region1[15].Y:=287;
　　Region1[16].X:=488; Region1[16].Y:=288;
　　Region1[17].X:=487; Region1[17].Y:=288;
　　Region1[18].X:=487; Region1[18].Y:=289;
　　Region1[19].X:=486; Region1[19].Y:=289;
　　Region1[20].X:=486; Region1[20].Y:=290;
　　Region1[21].X:=484; Region1[21].Y:=290;
　　Region1[22].X:=484; Region1[22].Y:=291;
　　Region1[23].X:=101; Region1[23].Y:=291;
　　Region1[24].X:=100; Region1[24].Y:=290;
　　Region1[25].X:=99; Region1[25].Y:=290;
　　Region1[26].X:=98; Region1[26].Y:=289;
　　Region1[27].X:=97; Region1[27].Y:=288;
　　Region1[28].X:=96; Region1[28].Y:=287;
　　Region1[29].X:=95; Region1[29].Y:=286;
　　Region1[30].X:=95; Region1[30].Y:=284;
　　Region1[31].X:=94; Region1[31].Y:=283;
　　Region1[32].X:=94; Region1[32].Y:=200;
　　Region1[33].X:=93; Region1[33].Y:=199;
　　Region1[34].X:=93; Region1[34].Y:=198;
　　Region1[35].X:=92; Region1[35].Y:=197;
　　Region1[36].X:=91; Region1[36].Y:=196;
　　Region1[37].X:=90; Region1[37].Y:=195;
　　Region1[38].X:=89; Region1[38].Y:=194;
　　Region1[39].X:=88; Region1[39].Y:=194;
　　Region1[40].X:=87; Region1[40].Y:=193;
　　Region1[41].X:=14; Region1[41].Y:=193;
　　Region1[42].X:=13; Region1[42].Y:=192;
　　Region1[43].X:=12; Region1[43].Y:=192;
　　Region1[44].X:=11; Region1[44].Y:=191;
　　Region1[45].X:=10; Region1[45].Y:=190;
　　Region1[46].X:=9; Region1[46].Y:=189;
　　Region1[47].X:=8; Region1[47].Y:=188;
　　Region1[48].X:=8; Region1[48].Y:=187;
　　Region1[49].X:=7; Region1[49].Y:=186;
　　Region1[50].X:=7; Region1[50].Y:=184;
　　Region1[51].X:=6; Region1[51].Y:=183;
　　Region1[52].X:=6; Region1[52].Y:=12;
　　Region1[53].X:=7; Region1[53].Y:=11;
　　Region1[54].X:=7; Region1[54].Y:=10;
　　Region1[55].X:=8; Region1[55].Y:=9;
　　Region1[56].X:=9; Region1[56].Y:=8;
　　Region1[57].X:=10; Region1[57].Y:=7;
　　Region1[58].X:=11; Region1[58].Y:=7;
　　Region1hrgn:=CreatePolygonRgn(Region1[0],59,2);
　　SetWindowRgn(Handle, Region1hrgn, Tr);
　　end;
　　◇[DELPHI]LISTVIEW实现隔行背景颜色
　　procedure Tform1.ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
　　Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
　　var DefaultDraw: Boolean);
　　begin
　　if item.Index mod 2 = 1 then
　　begin
　　sender.Canvas.Brush.Color:=clYellow;
　　end
　　else
　　sender.Canvas.Brush.Color:=clwhite;
　　end;
　　◇[DELPHI]判断机器是否网络状态
　　uses WinInet;
　　procedure Tform1.Button1Click(Sender: TObject);
　　function GetOnlineStatus : Boolean;
　　var ConTypes : Integer;
　　begin
　　ConTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY;
　　if (InternetGetConnectedState(@ConTypes, 0) = False)
　　then Result := False
　　else Result := Tr;
　　end;
　　begin
　　if not GetOnlineStatus then ShowMessage('Not Connected');
　　end;
　　◇[DELPHI]窗体渐渐出现
　　AnimateWindow(Handle,1000,AW_CENTER);
　　//在窗体创建事件中
　　◇[DELPHI]制作竖式菜单图片的关键代码
　　ONDrawItem事件
　　begin
　　acanvas.Draw(0,2,image1.picture.bitmap); anvas.TextOut(arect.left+image1.picture.bitmap.width+2,arect.top,tmenuitem(sender).caption);
　　end;
　　◇[软件开发]目前几个热门开发工具含义
　　Borland Enterprise St io, Java Edition 是一个完整的电子商务开发平台，能够加速
　　J2EE架构的电子商务应用系统投向市场的周期。
　　Borland Enterprise St io提供了完整的应用程序开发周期解决方案，
　　全面集成业界领先的Java 应用设计、开发和过程管理解决方案。
　　包含以下技术：
　　Borland JBuilder：市场份额居首位的 Java 开发工具
　　Borland AppServer：企业级 J2EE 应用服务器
　　Rational Rose Modeler 2001：世界领先的可视化建模工具
　　Rational Rose with JBuilder integration：建立在 Rose 模型和 JBuilder 应用程序之间的双向引擎
　　Rational Unified Process：最先进的软件开发管理思想和工具
　　◇[软件开发]Rational的工具集的功能解释
　　Rational Suite是Rational公司开发的一套为协助软件开发者进行软件开发的协
　　助工具套件，主要由以下几个软件构成(中文译名按Rational中国代理翻译）：
　　Rational Unified Process
　　Requisite Pro需求管理工具（整个开发过程）
　　Clear Case配置管理工具（整个开发过程，包括版本管理、进程控制）
　　Clear Qst变更请求管理工具（整个开发过程）
　　SoDA自动文档管理工具（整个开发过程）
　　ROSE可视化建模工具（建立软件模型，进行正向、逆向软件工程[engineering]）
　　Robot（软件测试用，通过Script自动模拟输入输出）
　　TestFactory（软件测试用）
　　Pure Coverage（测试时用，能自动检查那些代码没有被测试）
　　Purify（测试时用，检查运行时内存错误）
　　Q ntify（性能检测工具，查出系统瓶颈以便改进运行速度）
　　LoadTest
　　Performance Architect
　　面向不同的用户，Rational把以上的软件打成不同的开发包：
　　Analyst St io 主要面向系统分析员
　　Development St io 主要面向软件开发者
　　Test St io 主要面向测试工作者
　　Performance St io
　　Enterprise 主要面向企业
　　◇[软件开发]除rose以外UML设计工具
　　国内常见：
　　1、Vis l Modeler――微软的，安装Vis l St io就有,只是功能有点简单；
　　2、Rational Rose2000――Rational公司的，不用说啦，你嫌贵；
　　3、Paradigm Plus――CA公司的，太平洋公司代理，和Rose差不多具有强大的功能，只是Rational别的支持系统（如配置管理、测试）就不和他兼容了；
　　4、PlayCase――中科院沈阳研究所的，免费（强烈推荐试一试,因为它同时支持IDEF，也支持中国的MIS系统的要命的步骤：组织结构图――业务结构)；
　　5、Viso2000――也是微软的了，价格也不算太贵，不过用来做软件有点麻烦