[ Outline ] · Standard · Linear+ Windows Xp Trikowi, Owo je ipak zanimljivije i korisnije...

[NeverMore21]

E owako...Poshto su se swi wec smorili sa tipichnim algoritmima vezanih za brojeve, stringowe, nizowe itd. (zadaci sa bloka), ewo nove teme koja ce valjda biti zanimljivija i ne bash tako monotona! Swi koji hoce (i znaju) neka owde postuju funkcije i procedure vezane za Windows XP (znaci pre svega Win API)!!! I bez funkicja tipa: kako dobiti 3. znak iz verzije Service Pack-a, i slicno!!! Za pocetak, postovacu neke korisne funkcije i procedure!!! Ali u drugom postu!!! Pozzzz

[NeverMore21]

Pa dobro, nije da mi je dosadno ali ewo me 05! Postowacu josh par korisnih kodowa. Pa da pochnem:

Sledeca funkcija uslikawa trenutnu sliku ekrana i wratja je kao tip TBitmap (samo je dodelite Image-u):

CODE

function GetScreenShot: TBitmap;
var
 Desktop: HDC;
begin
 Result  := TBitmap.Create;
 Desktop := GetDC(0);
 try
   try
     Result.PixelFormat := pf32bit;
     Result.Width := Screen.Width;
     Result.Height := Screen.Height;
     BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, Desktop, 0, 0, SRCCOPY);
     Result.Modified := True;
   finally
     ReleaseDC(0, Desktop);
   end;
 except
   Result.Free;
   Result := nil;
 end;
end;

Sledecom funkicjom proverawate da li je trenutno ulogovani korisnik administrator:

CODE

const
 SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority =
   (Value: (0, 0, 0, 0, 0, 5));
 SECURITY_BUILTIN_DOMAIN_RID = $00000020;
 DOMAIN_ALIAS_RID_ADMINS = $00000220;

function IsAdmin: Boolean;
var
 hAccessToken: THandle;
 ptgGroups: PTokenGroups;
 dwInfoBufferSize: DWORD;
 psidAdministrators: PSID;
 x: Integer;
 bSuccess: BOOL;
begin
 Result   := False;
 bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True,
   hAccessToken);
 if not bSuccess then
 begin
   if GetLastError = ERROR_NO_TOKEN then
     bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY,
       hAccessToken);
 end;
 if bSuccess then
 begin
   GetMem(ptgGroups, 1024);
   bSuccess := GetTokenInformation(hAccessToken, TokenGroups,
     ptgGroups, 1024, dwInfoBufferSize);
   CloseHandle(hAccessToken);
   if bSuccess then
   begin
     AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
       SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS,
       0, 0, 0, 0, 0, 0, psidAdministrators);
     {$R-}
     for x := 0 to ptgGroups.GroupCount - 1 do
       if EqualSid(psidAdministrators, ptgGroups.Groups[x].Sid) then
       begin
         Result := True;
         Break;
       end;
     {$R+}
     FreeSid(psidAdministrators);
   end;
   FreeMem(ptgGroups);
 end;
end;

Hocete iz programa da ispraznite Recycle Bin, ewo reshenja:

CODE

procedure EmptyRecycleBin;
const
 SHERB_NOCONFIRMATION = $00000001;
 SHERB_NOPROGRESSUI = $00000002;
 SHERB_NOSOUND = $00000004;
type
 TSHEmptyRecycleBin = function(Wnd: HWND;
                               pszRootPath: PChar;
                               dwFlags: DWORD): HRESULT;  stdcall;
var
 SHEmptyRecycleBin: TSHEmptyRecycleBin;
 LibHandle: THandle;
begin
 LibHandle := LoadLibrary(PChar('Shell32.dll'));
 if LibHandle <> 0 then @SHEmptyRecycleBin :=
     GetProcAddress(LibHandle, 'SHEmptyRecycleBinA')
 else
 begin
   MessageDlg('Failed to load Shell32.dll.', mtError, [mbOK], 0);
   Exit;
 end;

 if @SHEmptyRecycleBin <> nil then
   SHEmptyRecycleBin(Application.Handle,
                     nil,
                     SHERB_NOCONFIRMATION or SHERB_NOPROGRESSUI or SHERB_NOSOUND);
 FreeLibrary(LibHandle); @SHEmptyRecycleBin := nil;
end;

I ewo, za danas josh jedan kod kojim mozete da upravljate jachinom zwuka media plejera:

CODE

uses
 MPlayer, MMSystem;
const
 MCI_SETAUDIO = $0873;
 MCI_DGV_SETAUDIO_VOLUME = $4002;
 MCI_DGV_SETAUDIO_ITEM = $00800000;
 MCI_DGV_SETAUDIO_VALUE = $01000000;
 MCI_DGV_STATUS_VOLUME = $4019;
type
 MCI_DGV_SETAUDIO_PARMS = record
   dwCallback: DWORD;
   dwItem: DWORD;
   dwValue: DWORD;
   dwOver: DWORD;
   lpstrAlgorithm: PChar;
   lpstrQuality: PChar;
 end;
type
 MCI_STATUS_PARMS = record
   dwCallback: DWORD;
   dwReturn: DWORD;
   dwItem: DWORD;
   dwTrack: DWORD;
 end;

procedure SetMPVolume(MP: TMediaPlayer; Volume: Integer);
 { Volume: 0 - 1000 }
var
 p: MCI_DGV_SETAUDIO_PARMS;
begin
 { Volume: 0 - 1000 }
 p.dwCallback := 0;
 p.dwItem := MCI_DGV_SETAUDIO_VOLUME;
 p.dwValue := Volume;
 p.dwOver := 0;
 p.lpstrAlgorithm := nil;
 p.lpstrQuality := nil;
 mciSendCommand(MP.DeviceID, MCI_SETAUDIO,
   MCI_DGV_SETAUDIO_VALUE or MCI_DGV_SETAUDIO_ITEM, Cardinal(@p));
end;

Eto, waljda ce nekom koristiti... ... Odoh sad malo na Rise of Nations ! Pozzz