|
; end;
except
ShowMessage(''''???′꧰ü'''');
Exit;
end;
end;
Application.MessageBox(''''1§?2?ú￡?êy?Y???′3é1|'''',''''ìáê?'''',MB_OK + MB_ICONINFORMATION);
end;
(9).查找局域网上的sqlserver报务器。
uses Comobj;
procedure TForm1.Button1Click(Sender: TObject);
var
SQLServer:Variant;
ServerList:Variant;
i,nServers:integer;
sRetValue:String;
begin
SQLServer := CreateOleObject(''''SQLDMO.Application'''');
ServerList:= SQLServer.ListAvailableSQLServers;
nServers:=ServerList.Count;
for i := 1 to nservers do
ListBox1.Items.Add(ServerList.Item(i));
SQLServer:=NULL;
serverList:=NULL;
end;
(10).窗体打开时的淡入效果。
procedure TForm1.FormCreate(Sender: TObject);
begin
AnimateWindow (Handle, 400, AW_CENTER);
end;
(11).动态创建窗体。
procedure TForm1.Button1Click(Sender: TObject);
begin
try
form2:=Tform2.Create(self);
form2.ShowModal;
finally
form2.Free;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action:=cafree;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
form1:=nil;
end;
(12).复制文件。
procedure TForm1.Button1Click(Sender: TObject);
begin
try
copyfileA(pchar(''''C:\AAA.txt''''),pchar(''''D:\AAA.txt''''),false);
except
showmessage(''''sfdsdf'''');
end;
end;
(13).复制文件夹。
uses shellAPI;
procedure TForm1.Button1Click(Sender: TObject);
var
lpFileOp: TSHFileOpStruct;
begin
with lpFileOp do
begin
Wnd:=Self.Handle;
wfunc:=FO_COPY;
pFrom:=pchar(''''C:\AAA'''');
pTo:=pchar(''''D:\AAA'''');
fFlags:=FOF_ALLOWUNDO;
hNameMappings:=nil;
lpszProgressTitle:=nil;
fAnyOperationsAborted:=True;
end;
if SHFileOperation(lpFileOp)<>0 then
ShowMessage(''''删除失败'''');
end;
(14).改变Dbgrid的选定色。
procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
Field: TField; State: TGridDrawState);
begin
if gdSelected in state then
SetBkColor(dbgrid1.canvas.handle,clgreen)
else
setbkcolor(dbgrid1.canvas.handle,clwhite);
dbgrid1.Canvas.TextRect(rect,0,0,field.AsString);
dbgrid1.Canvas.Textout(rect.Left,rect.Top,field.AsString);
end;
(15).检测系统是否已安装了ADO。
uses registry;
function Tform1.ADOInstalled:Boolean;
var
r:TRegistry;
s:string;
begin
r := TRegistry.create;
try
with r do
begin
RootKey := HKEY_CLASSES_ROOT;
OpenKey( ''''\ADODB.Connection\CurVer'''', false );
s := ReadString('''''''');
if s <> '''''''' then Result := True
else Result := False;
CloseKey;
end;
finally
r.free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if ADOInstalled then showmessage(''''this computer has installed ADO'''');
end;
(16).取利主机的ip地址。
uses winsock;
procedure TForm1.Button1Click(Sender: TObject);
var
IP:string;
IPstr:String;
buffer:array[1..32] of char;
i:integer;
WSData:TWSAdata;
Host:PHostEnt;
begin
if WSAstartup(2,WSData)<>0 then
begin
showmessage(''''WS2_32.DLL3?ê??ˉ꧰ü.'''');
exit;
end;
try
if GetHostname(@buffer[1],32)<>0 then
begin
showmessage(''''??óDμ?μ??÷?ú??.'''');
exit;
end;
except
showmessage(''''??óD3é1|·μ???÷?ú??'''');
exit;
end;
Host:=GetHostbyname(@buffer[1]);
if Host=nil then
begin
showmessage(''''IPμ??·?a??.'''');
exit;
end
else
begin
edit2.Text:=Host.h_name;
edit3.Text:=chr(host.h_addrtype+64);
for i:=1 to 4 do
begin
IP:=inttostr(ord(host.h_addr^[i-1]));
if i<4 then
ipstr:=ipstr+IP+''''.''''
else
edit1.Text:=ipstr+ip;
end;
end;
WSACleanup;
end;
(17).取得计算机名。
function tform1.get_name:string;
var ComputerName: PChar; size: DWord;
begin
GetMem(ComputerName,255);
size:=255;
if GetComputerName(ComputerName,size)=False then
result:=''''''''
else
result:=ComputerName;
FreeMem(ComputerName);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption:=get_name;
end;
(18).取得硬盘序列号。
function tform1.GetHDSerialNumber: LongInt;
{$IFDEF WIN32}
var
pdw : pDWord;
mc, fl : dword;
{$ENDIF}
begin
{$IfDef WIN32}
New(pdw);
GetVolumeInformation(''''c:\'''',nil,0,pdw,mc,fl,nil,0);
Result := pdw^;
dispose(pdw);
{$ELSE}
&nbs
上一页 [1] [2] [3] [4] [5] [6] [7] 下一页
[Delphi程序]先人的DELPHI基础开发技巧
|
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
