大富翁论坛-富翁笔记-delphi技巧.mht

大富翁论坛-富翁笔记-delphi技巧, 一个牛人的编程经验和笔记, 强烈推荐

SQL=D3=EF=BE=E4=A3=AC=BB=F2=D5=DF=D4=DATQuery=B5=C4SQL=D6=D0=CC=EE=C8=EBS=
QL=D3=EF=BE=E4=A1=A3=D7=EE=BA=F3=A3=AC=B1=F0=CD=FC=C1=CB=BD=ABActive=B8=C4=
=CE=AATrue=A1=A3
=D4=DA=D4=CB=D0=D0=D2=B2=BF=C9=C4=DC=C5=E4=D6=C3TQuery,=BE=DF=CC=E5=BC=FB=
Delphi=B0=EF=D6=FA=A1=A3

=A1=F5=A1=F3[DELPHI]=B5=C3=B5=BD=CD=BC=CF=F1=C9=CF=C4=B3=D2=BB=B5=E3=B5=C4=
RGB=D6=B5
procedure Tform1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
red,green,blue:byte ;
i:integer;
begin
i:=3D image1.Canvas.Pixels[x,y];
Blue:=3D GetBvalue(i);
Green:=3D GetGvalue(i):=20
Red:=3D GetRvalue(i);=20
Label1.Caption:=3Dinttostr(Red);
Label2.Caption:=3Dinttostr(Green);
Label3.Caption:=3Dinttostr(Blue);
end;

=A1=F5=A1=F3[DELPHI]=B9=D8=D3=DA=C8=D5=C6=DA=B8=F1=CA=BD=B7=D6=BD=E2=D7=AA=
=BB=BB
var year,month,day:word;now2:Tdatatime;
now2:=3Ddate();
decodedate(now2,year,month,day);
lable1.Text =
:=3Dinttostr(year)+'=C4=EA'+inttostr(month)+'=D4=C2'+inttostr(day)+'=C8=D5=
';=20

=A1=F3[DELPHI]=C8=E7=BA=CE=C5=D0=B6=CF=B5=B1=C7=B0=CD=F8=C2=E7=C1=AC=BD=D3=
=B7=BD=CA=BD
=C5=D0=B6=CF=BD=E1=B9=FB=CA=C7MODEM=A1=A2=BE=D6=D3=F2=CD=F8=BB=F2=CA=C7=B4=
=FA=C0=ED=B7=FE=CE=F1=C6=F7=B7=BD=CA=BD=A1=A3
uses wininet;=20
Function ConnectionKind :boolean;=20
var flags: dword;=20
begin=20
Result :=3D InternetGetConnectedState(@flags, 0);=20
if Result then=20
begin=20
if (flags and INTERNET_CONNECTION_MODEM) =3D INTERNET_CONNECTION_MODEM =
then=20
begin=20
showmessage('Modem');=20
end;=20
if (flags and INTERNET_CONNECTION_LAN) =3D INTERNET_CONNECTION_LAN then=20
begin=20
showmessage('LAN');=20
end;=20
if (flags and INTERNET_CONNECTION_PROXY) =3D INTERNET_CONNECTION_PROXY =
then=20
begin=20
showmessage('Proxy');=20
end;=20
if (flags and =
INTERNET_CONNECTION_MODEM_BUSY)=3DINTERNET_CONNECTION_MODEM_BUSY then=20
begin=20
showmessage('Modem Busy');=20
end;=20
end;=20
end;=20

=A1=F3[DELPHI]=C8=E7=BA=CE=C5=D0=B6=CF=D7=D6=B7=FB=B4=AE=CA=C7=B7=F1=CA=C7=
=D3=D0=D0=A7EMAIL=B5=D8=D6=B7
function IsEMail(EMail: String): Boolean;=20
var s: String;ETpos: Integer;=20
begin=20
ETpos:=3D pos('@', EMail);=20
if ETpos > 1 then=20
begin=20
s:=3D copy(EMail,ETpos+1,Length(EMail));=20
if (pos('.', s) > 1) and (pos('.', s) < length(s)) then=20
Result:=3D true else Result:=3D false;=20
end=20
else=20
Result:=3D false;=20
end;=20

=A1=F3[DELPHI]=C5=D0=B6=CF=CF=B5=CD=B3=CA=C7=B7=F1=C1=AC=BD=D3INTERNET
=D0=E8=D2=AA=D2=FD=C8=EBURL.DLL=D6=D0=B5=C4InetIsOffline=BA=AF=CA=FD=A1=A3=
=20
=BA=AF=CA=FD=C9=EA=C3=F7=CE=AA=A3=BA
function InetIsOffline(Flag: Integer): Boolean; stdcall; external =
'URL.DLL';=20
=C8=BB=BA=F3=BE=CD=BF=C9=D2=D4=B5=F7=D3=C3=BA=AF=CA=FD=C5=D0=B6=CF=CF=B5=CD=
=B3=CA=C7=B7=F1=C1=AC=BD=D3=B5=BDINTERNET
if InetIsOffline(0) then ShowMessage('not connected!')=20
else ShowMessage('connected!');=20
=B8=C3=BA=AF=CA=FD=B7=B5=BB=D8TRUE=C8=E7=B9=FB=B1=BE=B5=D8=CF=B5=CD=B3=C3=
=BB=D3=D0=C1=AC=BD=D3=B5=BDINTERNET=A1=A3
=B8=BD=A3=BA
=B4=F3=B6=E0=CA=FD=D7=B0=D3=D0IE=BB=F2OFFICE97=B5=C4=CF=B5=CD=B3=B6=BC=D3=
=D0=B4=CBDLL=BF=C9=B9=A9=B5=F7=D3=C3=A1=A3
InetIsOffline
BOOL InetIsOffline(
DWORD dwFlags,=20
);

=A1=F3[DELPHI]=BC=F2=B5=A5=B5=D8=B2=A5=B7=C5=BA=CD=D4=DD=CD=A3WAV=CE=C4=BC=
=FE
uses mmsystem;

function PlayWav(const FileName: string): Boolean;=20
begin=20
Result :=3D PlaySound(PChar(FileName), 0, SND_ASYNC);=20
end;=20

procedure StopWav;=20
var=20
buffer: array[0..2] of char;=20
begin=20
buffer[0] :=3D #0;=20
PlaySound(Buffer, 0, SND_PURGE);=20
end;=20

=A1=F3[DELPHI]=C8=A1=BB=FA=C6=F7BIOS=D0=C5=CF=A2
with Memo1.Lines do=20
begin=20
Add('MainBoardBiosName:'+^I+string(Pchar(Ptr($FE061))));=20
Add('MainBoardBiosCopyRight:'+^I+string(Pchar(Ptr($FE091))));=20
Add('MainBoardBiosDate:'+^I+string(Pchar(Ptr($FFFF5))));=20
Add('MainBoardBiosSerialNo:'+^I+string(Pchar(Ptr($FEC71))));=20
end;=20

=A1=F3[DELPHI]=CD=F8=C2=E7=CF=C2=D4=D8=CE=C4=BC=FE
uses UrlMon;

function DownloadFile(Source, Dest: string): Boolean;=20
begin=20
try=20
Result :=3D UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) =
=3D 0;=20
except=20
Result :=3D False;=20
end;=20
end;=20

if DownloadFile('http://www.borland.com/delphi6.zip, 'c:\kylix.zip') =
then=20
ShowMessage('Download succesful')=20
else ShowMessage('Download unsuccesful')=20

=A1=F3[DELPHI]=BD=E2=CE=F6=B7=FE=CE=F1=C6=F7IP=B5=D8=D6=B7
uses winsock=20

function IPAddrToName(IPAddr : String): String;=20
var=20
SockAddrIn: TSockAddrIn;=20
HostEnt: PHostEnt;=20
WSAData: TWSAData;=20
begin=20
WSAStartup($101, WSAData);=20
SockAddrIn.sin_addr.s_addr:=3D inet_addr(PChar(IPAddr));=20
HostEnt:=3D gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);=20
if HostEnt<>nil then result:=3DStrPas(Hostent^.h_name) else =
result:=3D'';=20
end;=20

=A1=F3[DELPHI]=C8=A1=B5=C3=BF=EC=BD=DD=B7=BD=CA=BD=D6=D0=B5=C4=C1=AC=BD=D3=

function ExeFromLink(const linkname: string): string;=20
var=20
FDir,=20
FName,=20
ExeName: PChar;=20
z: integer;=20
begin=20
ExeName:=3D StrAlloc(MAX_PATH);=20
FName:=3D StrAlloc(MAX_PATH);=20
FDir:=3D StrAlloc(MAX_PATH);=20
StrPCopy(FName, ExtractFileName(linkname));=20
StrPCopy(FDir, ExtractFilePath(linkname));=20
z:=3D FindExecutable(FName, FDir, ExeName);=20
if z > 32 then=20
Result:=3D StrPas(ExeName)=20
else=20
Result:=3D '';=20
StrDispose(FDir);=20
StrDispose(FName);=20
StrDispose(ExeName);=20
end;=20

=A1=F3[DELPHI]=BF=D8=D6=C6TCombobox=B5=C4=D7=D4=B6=AF=CD=EA=B3=C9
{'Sorted' property of the TCombobox to true }=20
var lastKey: Word; //=C8=AB=BE=D6=B1=E4=C1=BF
//TCombobox=B5=C4OnChange=CA=C2=BC=FE=20
procedure Tform1.AutoCompleteChange(Sender: TObject);=20
var=20
SearchStr: string;=20
retVal: integer;=20
begin=20
SearchStr :=3D (Sender as TCombobox).Text;=20
if lastKey <> VK_BACK then // backspace: VK_BACK or $08=20
begin=20
retVal :=3D (Sender as TCombobox).Perform(CB_FINDSTRING, -1, =
LongInt(PChar(SearchStr)));=20
if retVal > CB_Err then=20
begin=20
(Sender as TCombobox).ItemIndex :=3D retVal;=20
(Sender as TCombobox).SelStart :=3D Length(SearchStr);=20
(Sender as TCombobox).SelLength :=3D=20
(Length((Sender as TCombobox).Text) - Length(SearchStr));=20
end; // retVal > CB_Err=20
end; // lastKey <> VK_BACK=20
lastKey :=3D 0; // reset lastKey=20
end;=20
//TCombobox=B5=C4onKeyDown=CA=C2=BC=FE
procedure Tform1.AutoCompleteKeyDown(Sender: TObject; var Key: Word;=20
Shift: TShiftState);=20
begin=20
lastKey :=3D Key;=20
end;=20

=A1=F3[DELPHI]=C8=E7=BA=CE=C7=E5=BF=D5=D2=BB=B8=F6=C4=BF=C2=BC=20
function EmptyDirectory(TheDirectory :String ; Recursive : Boolean) :
Boolean;
var
SearchRec : TSearchRec;
Res : Integer;
begin
Result :=3D False;
TheDirectory :=3D NormalDir(TheDirectory);
Res :=3D FindFirst(TheDirectory + '*.*', faAnyFile, SearchRec);
try
while Res =3D 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 :=3D FindNext(SearchRec);
end;
Result :=3D True;
finally
FindClose(SearchRec.FindHandle);
end;
end;

=A1=F3[DELPHI]=B0=B2=D7=B0=B3=CC=D0=F2=C8=E7=BA=CE=CC=ED=BC=D3=B5=BDUnins=
tall=C1=D0=B1=ED
=B2=D9=D7=F7=D7=A2=B2=E1=B1=ED=A3=AC=C8=E7=CF=C2=A3=BA
1.=D4=DAHKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Unin=
stall=BC=FC=CF=C2=BD=A8=C1=A2=D2=BB=B8=F6=D6=F7=BC=FC=A3=AC=C3=FB=B3=C6=C8=
=CE=D2=E2=A1=A3
=C0=FDHKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninst=
all\MyUninstall
2.=D4=DAHKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Unin=
stall\MyUnistall=CF=C2=BC=FC=C1=BD=B8=F6=B4=AE=D6=B5=A3=AC
=D5=E2=C1=BD=B8=F6=B4=AE=D6=B5=B5=C4=C3=FB=B3=C6=CA=C7=CC=D8=B6=A8=B5=C4=A3=
=BADisplayName=BA=CDUninstallString=A1=A3
3.=B8=F8=B4=AEDisplayName=B8=B3=D6=B5=CE=AA=CF=D4=CA=BE=D4=DA=A1=B0=C9=BE=
=B3=FD=D3=A6=D3=C3=B3=CC=D0=F2=C1=D0=B1=ED=A1=B1=D6=D0=B5=C4=C3=FB=B3=C6=A3=
=AC=C8=E7'Aiming Uninstall one';
=B8=F8=B4=AEUninstallString=B8=B3=D6=B5=CE=AA=D6=B4=D0=D0=B5=C4=C9=BE=B3=FD=
=C3=FC=C1=EE=A3=AC=C8=E7 C:\WIN97\uninst.exe -f"C:\TestPro\aimTest.isu"

=A1=F3[DELPHI]=BD=D8=BB=F1WM_QUERYENDSESSION=B9=D8=BB=FA=CF=FB=CF=A2
type
Tform1 =3D 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;

=A1=F3[DELPHI]=BB=F1=C8=A1=CD=F8=C9=CF=C1=DA=BE=D3
procedure =
getnethood();//NT=D7=F6=B7=FE=CE=F1=C6=F7=A3=ACWIN98=C9=CF=B5=F7=CA=D4=CD=
=A8=B9=FD=A1=A3
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:=3Dtstringlist.Create ;
with netres[0] do begin
dwscope :=3DRESOURCE_GLOBALNET;
dwtype :=3DRESOURCETYPE_ANY;
dwdisplaytype :=3DRESOURCEDISPLAYTYPE_DOMAIN;
dwusage :=3DRESOURCEUSAGE_CONTAINER;
lplocalname :=3Dnil;
lpremotename :=3Dnil;
lpcomment :=3Dnil;
lpprovider :=3Dnil;
end; // =BB=F1=C8=A1=CB=F9=D3=D0=B5=C4=D3=F2
errcode:=3Dwnetopenenum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY,RESOURCEUSAGE=
_CONTAINER,@netres[0],enumhandle);
if errcode=3DNO_ERROR then begin
enumentries:=3D1024;
buffersize:=3Dsizeof(netres);
errcode:=3Dwnetenumresource(enumhandle,enumentries,@netres[0],buffersize)=
;
end;
a:=3D0;
mylistitems :=3Dcontrolcenter.lstcomputer.Items ;
mylistitems.Clear ;
while (string(netres[a].lpprovider)<>'') and (errcode=3DNO_ERROR) =
do
begin
alldomain.Add (netres[a].lpremotename);
a:=3Da+1;
end;
wnetcloseenum(enumhandle);
// =BB=F1=C8=A1=CB=F9=D3=D0=B5=C4=BC=C6=CB=E3=BB=FA
mylistitems :=3Dcontrolcenter.lstcomputer.Items ;
mylistitems.Clear ;
for i:=3D0 to alldomain.Count-1 do
begin
with netres[0] do begin
dwscope :=3DRESOURCE_GLOBALNET;
dwtype :=3DRESOURCETYPE_ANY;
dwdisplaytype :=3DRESOURCEDISPLAYTYPE_SERVER;
dwusage :=3DRESOURCEUSAGE_CONTAINER;
lplocalname :=3Dnil;
lpremotename :=3Dpchar(alldomain[i]);
lpcomment :=3Dnil;
lpprovider :=3Dnil;
end;
ErrCode:=3DWNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY,RESOURCEUSAGE=
_CONTAINER,@netres[0],EnumHandle);
if errcode=3DNO_ERROR then
begin
EnumEntries:=3D1024;
BufferSize:=3DSizeOf(NetRes);
ErrCode:=3DWNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],BufferSize)=
;
end;
a:=3D0;
while (string(netres[a].lpprovider)<>'') and (errcode=3DNO_ERROR) =
do
begin
mylistitem :=3Dmylistitems.Add ;
mylistitem.ImageIndex :=3D0;
mylistitem.Caption =
:=3Duppercase(stringreplace(string(NetRes[a].lpremotename),'\\','',[rfRep=