offline
- NuLLCoDe
- Legendarni građanin
- Đuro Glumac
- dipl. ing. informatike
- Pridružio: 08 Feb 2004
- Poruke: 3640
- Gde živiš: ApAtIn
|
Ipitivanje da li ste trenutno konektovani na Internet?
~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TForm1.Button1Click(Sender: TObject) ;
function FuncAvail(_dllname, _funcname: string;
var _p: pointer): boolean;
{return True if _funcname exists in _dllname}
var _lib: tHandle;
begin
Result := false;
if LoadLibrary(PChar(_dllname)) = 0 then exit;
_lib := GetModuleHandle(PChar(_dllname)) ;
if _lib <> 0 then begin
_p := GetProcAddress(_lib, PChar(_funcname)) ;
if _p <> NIL then Result := true;
end;
end;
{
Call SHELL32.DLL for Win > Win98
otherwise call URL.dll
}
{buton code:}
var
InetIsOffline : function(dwFlags: DWORD):
BOOL; stdcall;
begin
if FuncAvail('URL.DLL', 'InetIsOffline',
@InetIsOffline) then
if InetIsOffLine(0) = true
then ShowMessage('Not connected')
else ShowMessage('Connected!') ;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~
Enable/Disable the Windows 'START' button
~~~~~~~~~~
//Enable:
EnableWindow(FindWindowEx(FindWindow
('Shell_TrayWnd', nil), 0,'Button',nil),TRUE) ;
//Disable:
EnableWindow(FindWindowEx(FindWindow
('Shell_TrayWnd', nil), 0,'Button',nil),FALSE) ;
~~~~~~~~~~
Show/Hide the TaskBar in Windows
~~~~~~~~~~
//To hide the task bar use
ShowWindow(FindWindow
('Shell_TrayWnd',nil), SW_HIDE) ;
//To show the task bar use
ShowWindow(FindWindow
('Shell_TrayWnd',nil), SW_SHOWNA) ;
~~~~~~~~~~
Open & Close CD-drive from code
~~~~~~~~~~~~~~~~~~~~~~~~~
{ To OPEN the CD-ROM: }
mciSendString
('Set cdaudio door open wait', nil, 0, handle) ;
{ To CLOSE the CD-ROM: }
mciSendString
('Set cdaudio door closed wait', nil, 0, handle) ;
~~~~~~~~~~~~~~~~~~~~~~~~~
Show / Hide Desktop icons
~~~~~~~~~~~~~~~~~~~~~~~~~
procedure ShowDesktop(const YesNo : boolean) ;
var h : THandle;
begin
h := FindWindow('ProgMan', nil) ;
h := GetWindow(h, GW_CHILD) ;
if YesNo = True then
ShowWindow(h, SW_SHOW)
else
ShowWindow(h, SW_HIDE) ;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~
Hide/Show Tray icons
~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TraySHOW
var TopWindow : HWND;
begin
TopWindow:=
FindWindow('Shell_TrayWnd', nil) ;
TopWindow:=
FindWindowEx(TopWindow,0, 'ReBarWindow32', nil) ;
TopWindow:=
FindWindowEx(TopWindow,0, 'SysPager', nil) ;
ShowWindow( TopWindow,Sw_Show) ;
end;
procedure TrayHIDE
var TopWindow : HWND;
begin
TopWindow:=
FindWindow('Shell_TrayWnd', nil) ;
TopWindow:=
FindWindowEx(TopWindow,0, 'ReBarWindow32', nil) ;
TopWindow:=
FindWindowEx(TopWindow,0, 'SysPager', nil) ;
ShowWindow( TopWindow,Sw_Hide) ;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~
Empty Recycle Bin
~~~~~~~~~~~~~~~~~~~~~~~~~
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, ShellApi,Controls, Forms,
Dialogs,StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject) ;
end;
var Form1: TForm1;
function SHEmptyRecycleBin
(Wnd:HWnd; LPCTSTR:PChar;
DWORD:Word):Integer; stdcall;
const
SHERB_NOCONFIRMATION = $00000001;
SHERB_NOPROGRESSUI = $00000002;
SHERB_NOSOUND = $00000004;
implementation {$R *.DFM}
function SHEmptyRecycleBin; external
'SHELL32.DLL' name 'SHEmptyRecycleBinA';
procedure TForm1.Button1Click(Sender: TObject) ;
begin
SHEmptyRecycleBin(self.handle,'',
SHERB_NOCONFIRMATION) ;
end;
end.
~~~~~~~~~~~~~~~~~~~~~~~~~
Shut down Windows 2000 / XP / NT
~~~~~~~~~~~~~~~~~~~~~~~~~
function ShutdownNTplatform:boolean;
const
ADJUST_PRIV = TOKEN_QUERY or TOKEN_ADJUST_PRIVILEGES;
SHTDWN_PRIV = 'SeShutdownPrivilege';
PRIV_SIZE = sizeOf(TTokenPrivileges) ;
var
Len: DWORD;
TokenPriv, Dummy: TTokenPrivileges;
Token: THandle;
Text,
Machine:array [0..128] of Char;
Force,Reboot:boolean;
Error:integer;
begin
Error := 0;
if not OpenProcessToken(GetCurrentProcess(), ADJUST_PRIV, Token) then
Error := Error or 4;
{ ShowMessage('OpenProcessToken failed') ; }
if not LookupPrivilegeValue(nil, SHTDWN_PRIV,TokenPriv.Privileges[0].Luid) then
Error:=Error or 8;
{ ShowMessage('LookupPrivilegeValue failed') ; }
TokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
TokenPriv.PrivilegeCount := 1; // One privilege to set
if not AdjustTokenPrivileges(Token, false, TokenPriv, PRIV_SIZE,Dummy, Len) then
Error:=Error or 16;
{ ShowMessage('AdjustTokenPrivileges failed') ; }
StrPCopy(Text,FMessage) ;
StrPCopy(Machine,FMachineName) ;
InitiateSystemShutDown (Machine,Text,FTimeOut,True,False) ;
Result := (Error = 0) ;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~
From TTime and TDate to TDateTime
~~~~~~~~~~~~~~~~~~~~~~~~~
var
DateValue : TDate;
TimeValue: TTime;
OutDateTime : TDateTime;
...
// OutDateTime combines DateValue and TimeValue
OutDateTime := Int(DateValue) + Frac(TimeValue) ;
~~~~~~~~~~~~~~~~~~~~~~~~~
How to convert Seconds to Time
Here'a a simple function to convert an "amount" of seconds to HH:MM:SS string.
~~~~~~~~~~~~~~~~~~~~~~~~~
function SecToTime(Sec: Integer): string;
var
H, M, S: string;
ZH, ZM, ZS: Integer;
begin
ZH := Sec div 3600;
ZM := Sec div 60 - ZH * 60;
ZS := Sec - (ZH * 3600 + ZM * 60) ;
H := IntToStr(ZH) ;
M := IntToStr(ZM) ;
S := IntToStr(ZS) ;
Result := H + ':' + M + ':' + S;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~
Get Last Day in Month
~~~~~~~~~~~~~~~~~~~~~~~~~
function LastDayCurrMon: TDate;
var
y, m, d: word;
begin
decodedate(now, y, m, d) ;
m := m + 1;
if m > 12 then
begin
y := y + 1;
m := 1;
end;
result := encodedate(y, m, 1) - 1;
end;
{Usage:}
ShowMessage(DateToStr(LastDayCurrMon)) ;
~~~~~~~~~~~~~~~~~~~~~~~~~
Week number calculating
~~~~~~~~~~~~~~~~~~~~~~~~~
function WeekNum(const TDT:TDateTime) : Word;
var
Y,M,D:Word;
dtTmp:TDateTime;
begin
DecodeDate(TDT,Y,M,D) ;
dtTmp := EnCodeDate(Y,1,1) ;
Result :=
(Trunc(TDT-dtTmp)+(DayOfWeek(dtTmp)-1)) DIV 7;
if Result <> 0 then Result := Result - 1;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~
Nadam se da ce vam ovi sourcevi biti zanimljivi. Ako nesto nije jasno pitajte?
|
).
