◇[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]处理文件属性 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]取得系统运行的进程名 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]关于键盘常量名 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:$70(112)--$7B(123) A-Z:$41(65)--$5A(90) 0-9:$30(48)--$39(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]判断鼠标按键 if GetAsyncKeyState(VK_LButton)<>0 then ... //左键 if GetAsyncKeyState(VK_MButton)<>0 then ... //中键 if GetAsyncKeyState(VK_RButton)<>0 then ... //右键
◇[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;
◇[DELPHI]文本编辑相关 checkbox1.checked:=not checkbox1.checked; if checkbox1.checked then richedit1.font.style:=richedit1.font.style+[fsBold] else richedit1.font.style:=richedit1.font.style-[fsBold]//粗体 if checkbox1.checked then richedit1.font.style:=richedit1.font.style+[fsItalic] else richedit1.font.style:=richedit1.font.style-[fsItalic]//斜体 if checkbox1.checked then richedit1.font.style:=richedit1.font.style+[fsUnderline] else richedit1.font.style:=richedit1.font.style-[fsUnderline]//下划线 memo1.alignment:=taLeftJustify;//居左 memo1.alignment:=taRightJustify;//居右 memo1.alignment:=taCenter;//居中
◇[DELPHI]程序不出现在任务栏 uses windows 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]如何判断拨号网络是开还是关 if GetSystemMetrics(SM_NETWORK) AND $01 = $01 then showmessage('在线!') else showmessage('不在线!');
◇[DELPHI]实现IP到域名的转换 function GetDomainName(Ip:string):string; var pH:PHostent; data:twsadata; ii:dword; begin WSAStartup($101, Data); ii:=inet_addr(pchar(ip)); pH:=gethostbyaddr(@ii,sizeof(ii),PF_INET); if (ph<>nil) then result:=pH.h_name else result:='; WSACleanup; end;
◇[DELPHI]当前的光驱的盘符 procedure getcdrom(var cd:char); var str:string; drivers:integer; driver:char; i,temp:integer; begin drivers:=getlogicaldrives; temp:=(1 and drivers); for i:=0 to 26 do begin if temp=1 then begin driver:=char(i+integer('a')); str:=driver+':'; if getdrivetype(pchar(str))=drive_cdrom then begin cd:=driver; exit; end; end; drivers:=(drivers shr 1); temp:=(1 and drivers); end; end;
◇[DELPHI]字符的加密与解密 function cryptstr(const s:string; stype: dword):string; var i: integer; fkey: integer; begin result:='; case stype of 0: setpass; begin randomize; fkey := random($ff); for i:=1 to length(s) do result := result+chr( ord(s[i]) xor i xor fkey); result := result + char(fkey); end; 1: getpass begin fkey := ord(s[length(s)]); for i:=1 to length(s) - 1 do result := result+chr( ord(s[i]) xor i xor fkey); end; end;
□◇[DELPHI]向其他应用程序发送模拟键 var h: THandle; begin h := FindWindow(nil, '应用程序标题'); PostMessage(h, WM_KEYDOWN, VK_F9, 0);//发送F9键 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($101, 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 $08 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]截获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]目录完全删除(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;
◇[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]获得双字节字符内码 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) 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 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]最菜理解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:\1.MID TYPE SEQUENCER ALIAS NN', ', 0, 0); MCISendString('PLAY NN FROM 0', ', 0, 0); MCISendString('CLOSE ANIMATION', ', 0, 0); end; //停止播放 MCISendString('OPEN e:\1.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]检测光驱符号 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 <script LANGUAGE="JavaScript"> var myPlugin = navigator.plugins["Shockwave"]; if (myPlugin) document.writeln("你已经安装了 Shockwave!") else document.writeln("你尚未安装 Shockwave!") </script><br> <script LANGUAGE="JavaScript"> var myPlugin = navigator.plugins["Quicktime"]; if (myPlugin) document.writeln("你已经安装了Quicktime!") else document.writeln("你尚未安装 Quicktime!") </script>
◇[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'), True); 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, 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]发布ADO程序之安装ADO 运行一次 MDac_typ.exe ,这个文件在微软的 Windows、IE、Office、Visual Studio 中都有。 安装程序所安装后的目录与程序中设置的目录路径一样,C:\Program Files\Common Files\System\ado文件夹中有没有ADO组件,装ACCESS2000就有ADO2.1,没有则安装MS OFfice2000,编译要去掉project->Option->Packages对话框中的Build With RunTime Library的勾。
◇[DELPHI]文件名的非法字符过滤 for i:=1 to length(s) do if s[i] in ['\','/',':','*','?','<','>','|'] then 修改: try slist := tstringlist.create; slist.savetofile(s); result := true; 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', True) 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, True) 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 Value: 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[i] in ['a'..'z','A'..'Z','0'..'9','_','-','.']) then Exit; end; Result:= true; end; var i: integer; namePart, serverPart: string; begin // of IsValidEmail Result:= false; i:= Pos('@', Value); if (i = 0) or (pos('..', Value) > 0) then Exit; namePart:= Copy(Value, 1, i - 1); serverPart:= Copy(Value, i + 1, Length(Value)); if (Length(namePart) = 0) // @ or name missing or ((Length(serverPart) < 4)) // name or server missing or then Exit; // too short i:= Pos('.', serverPart); // must have dot and at least 3 places from end if (i = 0) or (i >= (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]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 := True; end; begin if not GetOnlineStatus then ShowMessage('Not Connected'); end;
◇[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 Studio, Java Edition 是一个完整的电子商务开发平台,能够加速 J2EE架构的电子商务应用系统投向市场的周期。 Borland Enterprise Studio提供了完整的应用程序开发周期解决方案, 全面集成业界领先的Java 应用设计、开发和过程管理解决方案。 包含以下技术: Borland JBuilder:市场份额居首位的 Java 开发工具 Borland AppServer:企业级 J2EE 应用服务器 Rational Rose Modeler 2001:世界领先的可视化建模工具 Rational Rose with JBuilder integration:建立在 Rose 模型和 JBuilder 应用程序之间的双向引擎 Rational Unified Process:最先进的软件开发管理思想和工具 Macromedia Dreamweaver UltraDev 4:提供专业的 Web 应用开发支持
◇[软件开发]Rational的工具集的功能解释 Rational Suite是Rational公司开发的一套为协助软件开发者进行软件开发的协 助工具套件,主要由以下几个软件构成(中文译名按Rational中国代理翻译): Rational Unified Process Requisite Pro需求管理工具(整个开发过程) Clear Case配置管理工具(整个开发过程,包括版本管理、进程控制) Clear Quest变更请求管理工具(整个开发过程) SoDA自动文档管理工具(整个开发过程) ROSE可视化建模工具(建立软件模型,进行正向、逆向软件工程[engineering]) Robot(软件测试用,通过Script自动模拟输入输出) TestFactory(软件测试用) Pure Coverage(测试时用,能自动检查那些代码没有被测试) Purify(测试时用,检查运行时内存错误) Quantify(性能检测工具,查出系统瓶颈以便改进运行速度) LoadTest Performance Architect 面向不同的用户,Rational把以上的软件打成不同的开发包: Analyst Studio 主要面向系统分析员 Development Studio 主要面向软件开发者 Test Studio 主要面向测试工作者 Performance Studio Enterprise 主要面向企业