نکات برنامه نویسی در دلفی

[پسر خاک]

محاسبه فاکتوریل یک عدد

function FacIterative(n: Word): Longint;

var

  f: LongInt;

  i: Integer;

begin

  f := 1;

  for i := 2 to n do f := f * i;

  Result := f;

end; 

function FacRecursive(n: Word): LongInt;

begin

  if n > 1 then

    Result := n * FacRecursive(n-1)

  else

    Result := 1;

end; 

[ParsaNM]

تغییر اندازه کلید Start..

procedure TForm1.Button1Click(Sender: TObject);

begin

  MoveWindow(FindWindowEx(FindWindow('Shell_TrayWnd'  , nil), 0, 'Button', nil),

             300, 0, 80, 22, true);

end;

[ParsaNM]

چک کردن اینکه آیا فایل در Local Drive می باشد.

function IsOnLocalDrive(aFileName: string): Boolean;

var

  aDrive: string;

begin

  aDrive := ExtractFileDrive(aFileName);

  if (GetDriveType(PChar(aDrive)) = DRIVE_REMOVABLE) or

     (GetDriveType(PChar(aDrive)) = DRIVE_FIXED) then

    Result := True

  else

    Result := False;

end;





// Example:

procedure TForm1.Button1Click(Sender: TObject);

begin

  if OpenDialog1.Execute then

    if IsOnLocalDrive(OpenDialog1.FileName) then

      ShowMessage(OpenDialog1.FileName + ' is on a local drive.');

end;

[ParsaNM]

چک کردن اینکه پارتیشن Fat میباشد یا NTFS

 

 

 

function GetHardDiskPartitionType(const DriveLetter: Char): string;

var

  NotUsed: DWORD;

  VolumeFlags: DWORD;

  VolumeInfo: array[0..MAX_PATH] of Char;

  VolumeSerialNumber: DWORD;

  PartitionType: array[0..32] of Char;

begin

  GetVolumeInformation(PChar(DriveLetter + ':\'),

    nil, SizeOf(VolumeInfo), @VolumeSerialNumber, NotUsed,

    VolumeFlags, PartitionType, 32);

  Result := PartitionType;

end;

 

 

procedure TForm1.Button1Click(Sender: TObject);

begin

  ShowMessage(GetHardDiskPartitionType('c'));

  ShowMessage(GetHardDiskPartitionType('a'));

end;

 

[ParsaNM]

چک کردن اینکه آیا سرویسی مورد نظر start می باشد

 

 

 

 

uses

  WinSvc;

 

function ServiceGetStatus(sMachine, sService: PChar): DWORD;

  {******************************************}

  {*** Parameters: ***}

  {*** sService: specifies the name of the service to open

  {*** sMachine: specifies the name of the target computer

  {*** ***}

  {*** Return Values: ***}

  {*** -1 = Error opening service ***}

  {*** 1 = SERVICE_STOPPED ***}

  {*** 2 = SERVICE_START_PENDING ***}

  {*** 3 = SERVICE_STOP_PENDING ***}

  {*** 4 = SERVICE_RUNNING ***}

  {*** 5 = SERVICE_CONTINUE_PENDING ***}

  {*** 6 = SERVICE_PAUSE_PENDING ***}

  {*** 7 = SERVICE_PAUSED ***}

  {******************************************}

var

  SCManHandle, SvcHandle: SC_Handle;

  SS: TServiceStatus;

  dwStat: DWORD;

begin

  dwStat := 0;

  // Open service manager handle.

  SCManHandle := OpenSCManager(sMachine, nil, SC_MANAGER_CONNECT);

  if (SCManHandle > 0) then

  begin

    SvcHandle := OpenService(SCManHandle, sService, SERVICE_QUERY_STATUS);

    // if Service installed

    if (SvcHandle > 0) then

    begin

      // SS structure holds the service status (TServiceStatus);

      if (QueryServiceStatus(SvcHandle, SS)) then

        dwStat := ss.dwCurrentState;

      CloseServiceHandle(SvcHandle);

    end;

    CloseServiceHandle(SCManHandle);

  end;

  Result := dwStat;

end;

 

function ServiceRunning(sMachine, sService: PChar): Boolean;

begin

  Result := SERVICE_RUNNING = ServiceGetStatus(sMachine, sService);

end;

 

// Check if Eventlog Service is running

procedure TForm1.Button1Click(Sender: TObject);

begin

  if ServiceRunning(nil, 'Eventlog') then

    ShowMessage('Eventlog Service Running')

  else

    ShowMessage('Eventlog Service not Running')

end;

 

[ParsaNM]

چک کردن اینکه آیا Sound card نصب شده است

 

 



uses

  MMSystem;



function SoundCardAvailable: Boolean;

begin

  Result := WaveOutGetNumDevs > 0;

end;

[ParsaNM]

چک کردن اینکه آیا دلفی در حال اجراست

 

 



function WindowExists(AppWindowName, AppClassName: string): Boolean;

var

  hwd: LongWord;

begin

  hwd    := 0;

  hwd    := FindWindow(PChar(AppWindowName), PChar(AppClassName));

  Result := False;

  if not (Hwd = 0) then {window was found if not nil}

    Result := True;

end;

 

function DelphiLoaded: Boolean;

begin

  DelphiLoaded := False;

  if WindowExists('TPropertyInspector', 'Object Inspector') then

    if WindowExists('TMenuBuilder', 'Menu Designer') then

      if WindowExists('TAppBuilder', '(AnyName)') then

        if WindowExists('TApplication', 'Delphi') then

          if WindowExists('TAlignPalette', 'Align') then

            DelphiLoaded := True;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

  if DelphiLoaded then

  begin

    ShowMessage('Delphi is running');

  end;

end;

 

function DelphiIsRunning: Boolean;

begin

  Result := DebugHook <> 0;

end;